VBA備忘録

これはブログではありません。ただのメモです。

●動的配列の宣言
Dim MyArray() As String

●指定したファイル（開いていること）にワークシートを追加し、名前を付ける
Workbooks(“Filename.xls”).Sheets.Add
Workbooks(“Filename.xls”).ActiveSheet.Name = “SheetName”

●エクセル関数をVBAで使う　事例では、関数 count を使っている
d = WorksheetFunction.Count(Range(“E:E”))

●指定したセルの読み上げ　　バージョン2002以降。
Range(“Q25”).Speak

●自己パス名を取得（その1）最後に\付き
MyPath = Left(ActiveWorkbook.FullName, _
Len(ActiveWorkbook.FullName) – Len(ActiveWorkbook.Name))

●自己パス名を取得（その2）最後に\なし
ActiveWorkbook.Path

●アクティブなファイル名を取得
myfile = ActiveWorkbook.Name

●アクティブなファイル名を取得（フルパス付き）
myfile = ActiveWorkbook.FullName

●マクロを実行しているファイル名を取得
myfile = ThisWorkbook.Name

●ワークシートの数
Worksheets.Count

●シート名の表示
MsgBox Worksheets(SheetNO).CodeName

●ユーザーフォームの表示
UserForm.show

●ユーザーフォームの非表示
Unload UserForm

●ユーザーフォーム上のチェックボックスのチェックを調べる
If UserForm1.CheckBox1.Value = True Then
MsgBox “チェックされています。”
End If

●ワークシートウインドウの最小化
ActiveWindow.WindowState = xlMinimized

●ワークシートウインドウの最大化
ActiveWindow.WindowState = xlMaximized

●選択範囲のセルの書式を文字列にする
Columns(“F:L”).Select
Selection.NumberFormatLocal = “@”

●エクセルファイルを開く
Workbooks.Open Filename:=ActiveWorkbook.Path & “\” & エクセルファイル名

●ファイルオープンのダイアログボックスを開き、エクセルファイルを開きます。
Application.Dialogs(xlDialogOpen).Show

●ファイルオープンのダイアログボックスでファイル名を取得
（Filename：フルパス付き　Filename2：ファイル名のみ）
Dim Filename As Variant
Dim Filename2 As Variant
Filename = Application.GetOpenFilename _
(“csvファイル (*.csv), *.csv”, , “ファイルの選択”, , False)　‘True とすると複数選択可能
Filename2 = Dir(Filename)

●アクティブなエクセルファイルのクローズ
ActiveWorkbook.Close

●エクセルファイルのクローズ
Workbooks(エクセルファイル名).Close

●エクセルファイルを保存せずにクローズ
Workbooks(ActiveWorkbook.Name).Close savechanges:=False

●エクセルファイルを保存してクローズ
Workbooks(ActiveWorkbook.Name).Close savechanges:=True

●開いているエクセルファイルに名前を付けて保存する
Workbooks(開いているファイル名).SaveAs (新しいファイル名)

●ファイルの削除
Kill myXlsFile

●テキストファイル・バイナリファイルの処理（シーケンシャル入力モード、バイト単位での入力）。
myFNo = FreeFile ‘使用可能なファイル番号を取得
Open myCsvFile For Input As #myFNo ‘ ファイルをシーケンシャル入力モードで開きます。
MaxSize = LOF(myFNo) ‘ ファイルのサイズをバイト数で取得します。
‘ Fort～Nextループを使って、
For NextChar = 1 To MaxSize – 1 Step 1 ’すべての文字を前から読み込みます。
Seek #myFNo, NextChar ‘ 位置を設定します。
MyChar = Input(1, #myFNo) ‘ 文字を読み込みます。
‘ここで処理をします。
Next NextChar
Close #myFNo ‘ csvファイルを閉じます。

●テキストファイルの処理（シーケンシャル入力モード、行単位での入力）。
myFNo = FreeFile ‘使用可能なファイル番号を取得
Open myTextFile For Input As #myFNo ‘ ファイルをシーケンシャル入力モードで開きます。
Do While Not EOF(myFNo) ‘ ファイルの終端までループを繰り返します。
Line Input #myFNo, myBuf ‘ 行を変数に読み込みます。
‘ここで処理をします。
Loop
Close #myFNo ‘ファイルを閉じます。

●シート間のコピーペースト（その1）
Worksheets(“Sheet3”).Rows(“1:1”).Copy
Worksheets(“Sheet2”).Paste (Rows(“1:1”))

●シート間のコピーペースト（その2）
Worksheets(S_sheet).Rows(row_no).Copy (Worksheets(D_sheet).Rows(D_row_no))

●セル幅を指定
Columns(“D:D”).ColumnWidth = 6.5

●セルの高さを指定
Rows(“9:9”).RowHeight = 40.5

●列の非表示
Columns(“B:B”).EntireColumn.Hidden = True

●列の表示
Columns(“B:B”).EntireColumn.Hidden = False

●確認のメッセージを出さずにSheet2を削除する
Application.DisplayAlerts = False
Worksheets(“Sheet2”).Delete
Application.DisplayAlerts = True
Yes (ms=6) No (ms=7) の確認ダイアログ
ms = MsgBox(“メッセージ。続けますか？”, vbYesNo)

●メッセージダイアログボックス内で改行する
MsgBox(“改行して二行で表示します。” & vbCr & _
“これが二行目です。”)

●正の整数のみを入力する
Do
MyValue = InputBox(“正の整数のみを入力します”)
Loop Until MyValue > 0 And IsNumeric(MyValue) = True

●アクティブなシートを保護する
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

●アクティブなシートの保護を解除する
ActiveSheet.Unprotect

●円を描く
Set WShape = Worksheets(“Sheet1”).Shapes
Set Obj1 = WShape.AddShape(msoShapeOval, h_oval, v_oval, 18, 18)　‘ 18, 19 とすれば楕円形
With Obj1
.Fill.Visible = msoFalse ‘塗りつぶし無し
.Line.Weight = xlThin ‘線を細線に、xlThinの代わりに1, 2, 3, 4 でもよい
.Name = “maru1”
End With

●円を削除
With Worksheets(“Sheet1”)
.Shapes(“maru1”).Delete
End With
Range()の使い方　この例では、セルA1からA10までに空白文字列を入れている
For T = 1 To 10
Range(“A” & T) = “”
Next T

●範囲を指定して印刷
ActiveSheet.PageSetup.PrintArea = “$A$1:$AO$46”
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

●一時的にプリンタを切り替える
tmpprtname = ActivePrinter ‘アクティブプリンタ名を保存
Application.ActivePrinter = “プリンタ名、マクロの記録で取得すること”
‘ここで処理
Application.ActivePrinter = tmpprtname ‘保存していたプリンタ名を戻す

●Withの使い方
With Workbooks(1).Worksheets(1)
.Cells(RowPos1, 3) = 1
.Cells(RowPos1, 3) = 2
.Cells(RowPos1, 3) = 3
.Cells(RowPos1, 3) = 4
End With

●Setの使い方
Set WS = Worksheets(1).Worksheets(1)
WS.Cells(RowPos2, 3) = 1
WS.Cells(RowPos2, 3) = 2
WS.Cells(RowPos2, 3) = 3
WS.Cells(RowPos2, 3) = 4

●Functionの使い方
Sub Main()
MsgBox Fname(10) ‘　5と表示されます。
End Sub

Function Fname(a)
Fname = a / 2
End Function

●ドライブ、フォルダの操作

1. フォルダを新規作成する

処理内容：C ドライブに新規にフォルダ「Text」を作成します。
Sub folder_1()
MkDir “C:¥Text”
End Sub

2. フォルダを削除する

処理内容：C ドライブのフォルダ「Text」を削除します。
Sub folder_2()
RmDir “C:¥Text”
End Sub

3. カレントフォルダの属性を取得する

処理内容：アクティブフォルダの属性をメッセージボックスに表示します。
Sub folder_3()
MsgBox GetAttr(CurDir)
End Sub

4. カレントディレクトリ（カレントフォルダ名）を取得する

処理内容：アクティブフォルダ名をメッセージボックスに表示します。
Sub folder_4
MsgBox CurDir
End Sub

5. カレントドライブをＦＤに変更する

処理内容：現在のドライブからFDドライブに変更します。
Sub folder_5()
ChDrive “A”
End Sub

6. カレントフォルダを変更する

処理内容：現在のアクティブフォルダを「VBA」というフォルダに変更します。
Sub folder_6()
ChDir “C:¥VBA”
End Sub

7. フォルダ名を変更する

処理内容：フォルダ名を「VBA」から「VBAMacro」に変更します。
Sub folder_7()
Name “C:¥VBA” AS “C:¥VBAMacro”
End Sub
現在、開いているファイルに対して Nameステートメントを実行するとエラーが発生します。
ファイル名を変える前に、開いているファイルを閉じて下さい。

●ファイルの新規作成

1. 既定のファイル(ブック)名で新規ブックを作成する

処理内容：ブック名を指定せず、既定のブック名で新規にブックを作成します。
Sub Book_1()
Workbooks.Add
End Sub
作成されるブック名は、「Book2」のようになります。

2. ファイル(ブック)名を指定して新規ファイルを作成

処理内容：「新規ブック」というファイル名を付けて新規ファイルを作成します。
Sub Book_2()
Dim Newbook As Workbook
Set Newbook = Workbooks.Add
Newbook.SaveAs FileName:=”新規ブック”
End Sub

3. フォルダに指定したファイルがないときは新規ファイルを作成

処理内容：フォルダ内に指定した名前のファイルがあれば開き、なければ新規作成します。
Sub Book_3()
Application.DisplayAlerts = False　　　’確認ダイアログを表示させない
Application.ScreenUpdating = False　　’画面更新を中断する<
On Error GoTo Err_chek
‘ フォルダ「MyData」に指定したファイルがあるとき、ファイルを展開する
Workbooks.Open Filename:=”D:¥MyData¥TEST.xls”, UpdateLinks:=0
Goto Owari
Err_chek:
‘ フォルダ「MyData」に指定したファイルがないとき、ファイルを新規作成して名前を付ける
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=”D:¥MyData¥TEST.xls”
Owari:
Application.DisplayAlerts = True　　　’確認ダイアログを表示する
Application.ScreenUpdating = True　 ‘画面更新を再開する
End Sub
Application.DisplayAlerts と Application.ScreenUpdatingの処理は無くてもかまいません。

●ファイルの展開

1. DドライブからExcelファイルを開く

処理内容：カレントドライブをDドライブに変更してから「VBA_PartsCollection」というファイルを展開します。
Sub BookOpen_1()
ChDir “D:”
Workbooks.Open Filename:=”VBA_PartsCollection.xls”
End Sub

2. 保存場所を特定してファイルを開く

処理内容：「C」ドライブの「VbaMacro」フォルダにある「ExcelVBA」というファイルを展開します。
Sub BookOpen_2()
Workbooks.Open Filename:=”C:¥VbaMacro¥ExcelVBA.xls”
End Sub

3. カレントフォルダのファイルを開く

処理内容：アクティブフォルダの中の「ExcelVBA」というファイルを展開します。
Sub BookOpen_3()
Workbooks.Open Filename:=”ExcelVBA.xls”
End Sub

4. カレントフォルダのファイルを開く(省略形)

処理内容：現在アクティブフォルダの中の「ExcelVBA」というファイルを展開します。
Sub BookOpen_4()
Workbooks.Open “ExcelVBA”
End Sub

5. 現在のブックをそのままにして新しくファイルを開く

処理内容：現在開かれているファイルを閉じずに、新しく「ExcelVBA」というファイルを展開し、元のファイルをアクティブにします。
Sub BookOpen_5()
Dim bkName As String
bkName = ActiveWorkbook.Name
Workbooks.Open “ExcelVBA.xls”
Workbooks(bkName).Activate
End Sub

6. 同じフォルダ内にあるExcelファイルを検索して開く

処理内容：同じフォルダにあるファイルを順次検索して、Excelファイル(xlsの拡張子がついているファイル)があれば開くかどうかを確認してから展開します。また、開いたファイルを閉じるときも確認してから閉じます。
Sub BookOpen_6()
Dim myPath As String
Dim myFName As String
Workbooks(“Book1.xls”).Activate
myPath = ActiveWorkbook.Path
ChDir myPath
myFName = Dir(“*.xls”)
Do Until myFName = “”
Rec = MsgBox(myFName & “を開きますか”, vbYesNo)
If Rec = vbYes Then
Workbooks.Open Filename:=myFName
Rec = MsgBox(myFName & “を閉じますか”, vbYesNo)
If Rec = vbYes Then
Workbooks(myFName).Close SaveChanges:=True
End If
End If
myFName = Dir()
Loop
End Sub

7. 指定したフォルダ内にあるExcelファイルを検索して開く

処理内容：指定したフォルダにあるファイルを順次検索して、Excelファイル(xlsの拡張子がついているファイル)があれば開くかどうかを確認してから展開します。
Sub BookOpen_7()
Dim i As Long
Dim FName As String
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = “D:¥MyData”
.SearchSubFolders = False 　　’サブフォルダは検索しない
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
FName = .FoundFiles(i)
Rec = MsgBox(FName & “を開きますか”, vbYesNo)
If Rec = vbYes Then
Workbooks.Open FName
End if
Next i
Else
MsgBox “対象ファイルはありませんでした”
End if
End With
Application.ScreenUpdating = True
End Sub

8. ＦＤのExcelファイルの名前を確認して開く

処理内容：フロッピーディスクにあるファイルを順次検索して、Excelファイル(xlsの拡張子がついているファイル)があれば開くかどうかを確認してから展開します。
Sub BookOpen_8()
Dim Filename As String
Filename = Dir(“A:¥*.xls”, vbNormal)
Do While Filename <> “”
Msg = “検索したファイル名＝ ” & Filename & vbCrLf & vbCrLf & _
“このファイルを開きますか”
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = “ファイル名確認”
MsgRec = MsgBox(Msg, Style, Title)
If MsgRec = vbYes Then
ChDir “A:¥”
Workbooks.Open “A:¥” & Filename
End If
Filename = Dir()
Loop
End Sub

9. 別のファイルをアクティブにする

処理内容：既に開かれている「Book1」をアクティブにします。
Sub BookOpen_9()
Workbooks(“Book1”).Activate
End Sub

●ファイルの検索

1. カレントドライブに有るファイルを検索してセルに表示

処理内容：カレントドライブ(現在開かれているフォルダ)のExcelファイルを順次検索して、ファイル名、サイズ、更新日時をセルに表示します。
Sub BookSearch_1()
Dim Fn As String
Dim i As Integer
Fn = Dir(“*.xls”, 0)
i = 1
Do Until Fn = “”
Cells(i, 1).Value = Fn
Cells(i, 2).Value = FileLen(Fn)
Cells(i, 3).Value = FileDateTime(Fn)
i = i + 1
Fn = Dir()
Loop
End Sub

2. 同じ名前のファイルがあるかどうかチェックする

処理内容：カレントドライブ(現在開かれているフォルダ)を検索して、同じ名前のファイルがあれば「同名のブックがあります」、なければ「同名のブックはありません」とメッセージボックスに表示します。
Sub BookSearch_2()
Dim BookName As String
Dim wb As Workbook
BookName = “VBA_PartsCollection.xls”
On Error Resume Next
Set wb = Workbooks(BookName)
On Error GoTo 0
If Not (wb Is Nothing) Then
MsgBox “同名のファイルがあります。”
Else
MsgBox “同名のファイルはありません。”
End If
Set wb = Nothing
End Sub

●ファイルの属性の取得・設定

1. ファイルの属性を設定する

処理内容：ファイル名「Text」の属性を「通常ファイル」に設定します。
なお、開いているファイルの属性を変更しようとすると実行時エラーが発生します。
Sub BookPath_1()
SetAttr “Test.xls”,vbNormal　　’ファイル名,属性
End Sub
定数(値)　　　　　内容
vbNormal (0) 　　(既定値)通常ファイル
vbReadOnly (1) 　読み取り専用ファイル
vbHidden (2)　　　隠しファイル
vbSystem (4) 　　　システムファイル。Macintoshでは使用できません。
vbArchive (32)　　アーカイブ(属性最後にバックアップした後で、変更されたファイル)
vbAlias (64)　　　　エイリアスファイル。Macintoshでのみ使用できます。
定数、値( )内の数値のどちらかを使用して設定します。

2. ファイルのパス・属性を取得する

処理内容：「D」ドライブの「MyData」フォルダにある「Test」ファイルのフルパス、パス、ファイル名、属性をセルに表示します。
Sub BookPath_2()
Cells(1,1).value = ThisWorkbook.FullName　’D:¥MyData¥Test.xls
Cells(2,1).value = ThisWorkbook.Path　　　　’D:¥MyData
Cells(3,1).value = ActiveWorkbook.Name　　’Test.xls
Cells(4,1).value = GetAttr(“Test.xls”)　　　　　’32
End Sub

ファイルを保存・閉じる

1. アクティブファイルの上書き保存

処理内容：現在、開かれているファイルを同名で上書き保存します。
Sub book_SaveClose1()
ActiveWorkbook.Save
End Sub

2. アクティブでないファイルを上書き保存する

処理内容：現在開かれてはいるが、アクティブでないファイルを上書き保存します。
Sub book_SaveClose2()
Workbooks(“VBAMACRO.xls”).Save
End Sub

3. ファイルをDドライブに新規保存（名前を付けて保存）

処理内容：新規作成したファイルをDドライブに新規保存します。
Sub book_SaveClose3()
ActiveWorkbook.SaveAs Filename:=”D:¥ExcelVBA Note.xls”
End Sub

4. アクティブファイルを上書き保存して閉じる

処理内容：現在開かれているファイルを上書き保存してから閉じます。
Sub book_SaveClose4()
ActiveWorkbook.Close SaveChanges:=True
End Sub

5. フロッピーディスクへの保存

処理内容：現在開かれているファイルをフロッピーディスクに保存します。
Sub book_SaveClose5()
ChDir “A:¥”
ActiveWorkbook.SaveAs Filename:=”A:¥ExcelVBA Note.xls”, _
FileFormat:=xlNormal
End Sub

6. 変更があった場合のみファイルを保存して閉じる

処理内容：ファイルのデータ内容に変更があったときだけ保存し、変更がないときは保存しないで閉じます。
Sub book_SaveClose6()
With ActiveWorkbook
If .Saved = True Then
.Close False
Else
.Close True
End If
End With
End Sub

7. ファイル名を指定して閉じる

処理内容：ファイル「ExcelVBA Index.xls」を閉じます。
Sub book_SaveClose7()
Workbooks(“ExcelVBA Index.xls”).Close
End Sub

8. アクティブファイルを閉じる

処理内容：現在開かれて入るファイルを閉じます。
Sub book_SaveClose8()
ActiveWorkbook.Close
End Sub

9. ～番目に開いたファイルを閉じる

処理内容：開かれた順番(プログラムでは2番目)を指定してファイルを閉じます。
Sub book_SaveClose9()
Workbooks(2).Close
End Sub

10. 確認メッセージを表示せずファイルを閉じる

処理内容：「”ファイル名”の変更を保存しますか」のメッセージを表示しないでファイルを閉じます。
Sub book_SaveClose10()
Workbooks(“ExcelVBA Index.xls”).Close SaveChanges:=True
End Sub

11. ファイルを保存しないで閉じる

処理内容：ファイルを保存しないでそのまま閉じます。
Sub book_SaveClose11()
Workbooks(“ExcelVBA Index.xls”).Close False
End Sub

12. すべてのワークブックを閉じる

処理内容：現在開かれているすべてのワークブックを閉じます。
Sub book_SaveClose12()
Workbooks.Close
End Sub