[vba] 新しいシートを作成し、グラフを指定箇所に作り、テキストファイルに出力する

VBAで今回やったことをメモ

①データを新しいsheetにコピペする
②散布図を指定した場所に作る
③txtファイルに①のデータ箇所を出力する

①型宣言～新しいsheetを指定箇所に作るところ

Sub anal()
Dim i As Long, j As Long '型宣言はintegerでもいいけど大体Longにしておけばいい
Dim a As Long, b As Long, c As Long
Dim f_path As String, shtnm As String '文字の宣言
Dim f_num As Long ' ファイル番号
Dim k As Long

a = Application.InputBox("変数xの行 @sheet(raw)") 'message boxをだして入力値よむ
b = Application.InputBox("変数yの行 @sheet(raw)")
c = 1 '書き出し列 @sheet(anal)
Application.DisplayAlerts = False 'シート削除の確認ダイアログを出さないようにする
i = 6
j = 2
shtnm = Sheets("raw").Cells(a, i - 4).Value & "vs" & Sheets("raw").Cells(b, i - 4).Value
'↑新しく作るsheetの名前を指定
'↓もし同名ファイルがあったら消す. 別moduleに後述のpgを入れておく必要がある
If SheetDetect(shtnm) Then
Worksheets(shtnm).Delete 
End If
'rawという名前のsheetの後ろにshtnmという新しいsheetを追加する
Worksheets.Add After:=Worksheets("raw")
ActiveSheet.Name = shtnm

以下 'raw'という名前のsheetを参考に新しいsheetにデータ書き込む

Sheets(shtnm).Cells(1, c).Value = Sheets("raw").Cells(a, i - 4).Value
Sheets(shtnm).Cells(1, c + 1).Value = Sheets("raw").Cells(b, i - 4).Value
Sheets(shtnm).Cells(1, c + 2).Value = "voicing"
While IsEmpty(Sheets("raw").Cells(3, i).Value) = False
For dt = 1 To 5
Sheets(shtnm).Cells(j + dt - 1, c).Value = Sheets("raw").Cells(a + dt - 1, i).Value 'x
Sheets(shtnm).Cells(j + dt - 1, c + 1).Value = Sheets("raw").Cells(b + dt - 1, i).Value 'y
Sheets(shtnm).Cells(j + dt - 1, c + 2).Value = Sheets("raw").Cells(a + dt - 1, 5).Value 'z
Next dt
j = j + 5
i = i + 1
Wend

②グラフを指定箇所につくる

With ActiveSheet.Shapes.AddChart.Chart
.ChartType = xlXYScatter '散布図にする
.SetSourceData Source:=Sheets(shtnm).Range(Cells(1, c), Cells(j, c + 1)) 'データ範囲
If .HasLegend Then .Legend.Delete '凡例を消す
.HasTitle = True 'タイトルあり
.ChartTitle.Font.Name = "MeiryoUI" 'タイトルのフォント指定
.ChartTitle.Font.Size = 12 'タイトルのフォントの大きさ指定
.ChartTitle.Text = shtnm 'タイトル指定
With Range("k2:o19") 'グラフの大きさ指定(cell使ってみた)
ActiveSheet.ChartObjects("グラフ 1").Top = Range("k2").Top 'グラフ左上の位置指定
ActiveSheet.ChartObjects("グラフ 1").Left = Range("k2").Left
ActiveSheet.ChartObjects("グラフ 1").Width = .Width
ActiveSheet.ChartObjects("グラフ 1").Height = .Height
End With
With .Axes(xlCategory) '横軸の設定
.HasTitle = True 'タイトルあり
.AxisTitle.Font.Name = "MeiryoUI"
.AxisTitle.Font.Size = 8
.AxisTitle.Text = Sheets(shtnm).Cells(1, 1).Value
.MajorUnit = 1 '目盛り指定
.MinimumScale = 1 '最小値
.MaximumScale = 10 '最大値
End With
With .Axes(xlValue) '縦軸の設定
.HasTitle = True
.AxisTitle.Font.Name = "MeiryoUI"
.AxisTitle.Font.Size = 8
.AxisTitle.Text = Sheets(shtnm).Cells(1, 2).Value
.MajorUnit = 1
.MinimumScale = 1
.MaximumScale = 10
End With
End With

③txtファイルに数字部分を書き出しする（操作しているbookと同じ場所にshtnm.txtという名前でtxtファイルを出力する）

f_path = ActiveWorkbook.Path & shtnm & ".txt" 
f_num = FreeFile
Open f_path For Output As f_num
'書き出す内容の指定と間にスペース入れる
For k = 2 To j
Print #f_num, Cells(k, c).Value; Spc(2); Cells(k, c + 1).Value; Spc(2); Cells(k, c + 2).Value
Next k
Close f_num
End Sub

以上. ただしdetectSheetという関数を使うためには, 次のソースコードを別のmoduleに入れておく必要があります.

Public Function SheetDetect(SName As String) As Boolean
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
If sht.Name = SName Then
SheetDetect = True
Exit Function
End If
Next
End Function