忘れがちなVBA

# ■ 変数宣言の強制化 : Option Explicit

~~~visualbasic
Option Explicit 
~~~

# ■ 画面の更新停止

~~~visualbasic
Application.ScreenUpdating = False
~~~

# ■ プロシージャ

~~~visualbasic
Sub main()
    Application.ScreenUpdating = False
    Call MessageStart
    MsgBox Output1 & Output2("World")
    Call MessageEnd("End")
End Sub

' Subプロシージャ
Sub MessageStart()
    MsgBox "Start"
End Sub

' Subプロシージャ(引数あり)
Sub MessageEnd(Message As String)
    MsgBox "End"
End Sub

' Functionプロシージャ
Function Output1() As String
    Output1 = "Hello "
End Function

' Functionプロシージャ(引数あり)
Function Output2(Message As String) As String
    Output2 = Message
End Function
~~~

# ■ 変数定義

~~~visualbasic
Public Dim a As Type          ' 他のモジュールで使用可能
Dim b As Type                 ' 同一モジュールで使用可能

Sub main()
    static Dim c As Type      ' 静的変数
    Dim d As Type             ' 同一プロシージャで使用可能
    const Dim e As Type = 10  ' 変更不可
    Dim array(2) As Type      ' 配列
    Dim arrayVarLen As Variant' 可変長配列

    array(1) = "one"
    array(2) = "two"
    arrayVarLen = {"one", "two"}

End Sub
~~~

|Type|Name|
|---|---|
|Variant|バリアント型|
|Byte|バイト型|
|Boolean|ブール型|
|String|文字列型|
|Integer|整数型|
|Long|長整数型|
|Single|単精度浮動小数点型|
|Double|倍精度浮動小数点型|
|Date|日付型|
|Currency|通貨型|
|Object|オブジェクト型|

# ■ 型変換

~~~visualbasic
Dim a As String
Dim b As String

Cells(1, 1) = CInt(a) + CInt(b)
~~~

変換関数|変換先
---|---
CStr|String型
CInt|Integer型
CLng|Long型



# ■ 文字列操作
## 左側抜き出し : left

~~~visualbasic
MsgBox Left(Range("A1"), 1)
~~~

## 中央抜き出し : mid
~~~visualbasic
MsgBox Mid(Range("A1"), 2, 3)
~~~

## 右側抜き出し : right
~~~visualbasic
MsgBox Right(Range("A1"), 1)
~~~

## 置換
~~~visualbasic
MsgBox Replace("100 points", " points", "") '100
~~~

## 結合
~~~visualbasic
Dim cnt As Integer
For cnt = 1 To 100 Step 1
  Range("A" & cnt) = cnt
  Range("B" + cnt) = cnt
Next
~~~

## 一致判定
~~~visualbasic
if InStr(String1, String2) <> 0 Then
  MsgBox "match between two Strings"
Else
  MsgBox "mismatch between two Strings"
End If
~~~


# ■ メッセージ入力 : InputBox

~~~visualbasic
Dim message As String
message = InputBox("メッセージを入力してください")
~~~

# ■ メッセージ出力 : MsgBox

## メッセージのみ出力
~~~visualbasic
MsgBox "Output Message"
~~~

## Yes/Noの選択
~~~visualbasic
If MsgBox("Output Messag", vbYesNo) = vbYes Then
    ' Yesの処理
Else
    ' Noの処理
End If
~~~

## OK/Cancelの選択
~~~visualbasic
If MsgBox("Output Messag", vbOKCancel) = vbOK Then
    ' OKの処理
End If
~~~

# ■ 警告／確認メッセージ非表示
~~~visualbasic
Application.DisplayAlerts = False
~~~

# ■ 条件分岐／ループ
## 条件分岐 : if
~~~visualbasic
If cnt > 1 Then
    Msgbox "カウントは1より大きい"
Else
    Msgbox "カウントは1以下"
End If
~~~

【比較演算子】
```A = B```  ：AとBが等しい場合、真
```A <> B``` ：AとBが等しくない場合、真
```A < B```  ：AがBより小さい場合、真
```A <= B``` ：AがB以下の場合、真
```A > B```  ：AがBより大きい場合、真
```A >= B``` ：AがB以上の場合、真

## 条件分岐 : select case
~~~visualbasic
Select Case cnt
Case 1
    Msgbox "カウントは1"
Case 2 To 4
    Msgbox "カウントは2から4"
Case Else
    Msgbox "それ以外"
End Select
~~~

## ループ : for next
~~~visualbasic
Dim cnt
For cnt = 1 To 10 Step 1
    Msgbox cnt
Next cnt
~~~

## ループ : do loop
~~~visualbasic
Dim cnt As Integer
cnt = 1
Do While Cells(1, cnt) = 0
    MsgBox cnt
    cnt = cnt + 1
    If cnt > 100 Then
        Exit Do
    End If
Loop
~~~

# ■ セル操作
## セルの選択

~~~visualbasic
Range("A1").Select
Cells(2, 1).Select
~~~

## セルの値取得

~~~visualbasic
Dim cnt1 As Integer
Dim cnt2 As Integer

cnt1 = Range("A1")
cnt2 = Cells(2, 1)
~~~

## セルに値設定

~~~visualbasic
Range("A1") = 100
Cells(2, 1) = "Hello"
~~~

## セルの値コピー

~~~visualbasic
Cells(1,1).Copy Destination:=Cells(1,2)
~~~

## 複数セルの値コピー
~~~visualbasic
Range("C1:C30").Value = Range("D1:D30").Value
~~~

## 複数セルのクリア
~~~visualbasic
Range("B6:D15").ClearContents
Range(Cells(6, 2), Cells(15, 4)).ClearContents
~~~

## 行の削除

~~~visualbasic
Rows("1").Delete
Rows("1:10").Delete
~~~

## 行の挿入

~~~visualbasic
Rows("2:3").Insert
~~~

## 列の削除

~~~visualbasic
Columns("A").Delete
Columns("A:D").Delete
~~~

## 列の挿入

~~~visualbasic
Columns("B:D").Insert
~~~

## 罫線を引く

~~~visualbasic
Range("A1:B2").Borders.LineStyle = xlContinuous
~~~

## 別シートのセル設定

~~~visualbasic
Sheets("Sheet2").Select
Range("A1") = 1000
~~~

# ■ シート操作
## アクティブ設定
~~~visualbasic
Sheets("Sheets Name").Activate
~~~

## アクティブ設定(存在有無を戻り値で返却)
~~~visualbasic
Private Function activateSheet(sheetName As String) As Boolean
    On Error Resume Next
    Err.Clear

    Sheets(sheetName).Activate

    If Err.Number > 0 Then
        activateSheet = False
    Else
        activateSheet = True
    End If

    On Error GoTo 0
End Function
~~~

## シート名変更
~~~visualbasic
ActiveSheet.Name = "test1"
Sheets("Sheets Name") = "test2"
~~~

## シートコピー
~~~visualbasic
Sheets("Sheets Name").Copy Before:=Sheets(Sheets.Count)  '最後尾にシートコピー
Sheets("Sheets Name").Copy Before:=Sheets(Sheets.Count)  '最後尾の一つ前にシートコピー
~~~

# ■ 日付操作
## 現在時刻設定
~~~visualbasic
Range("A1") = Date '2018/1/1
Range("A1") = Now  '2018/1/1 0:00:00
Range("A1") = Time '0:00:00
~~~

# ■ グラフ操作
## 範囲変更(縦項目とデータが離れている場合)
~~~visualbasic
Dim start As Variant
Dim end As Variant
start = "C"
finish = "F"
ActiveSheet.ChartObject("Graph Name").Active
ActiveChart.SetSourceData Union(Range("A1:A4"), Range(start & 1,finish & 4))
~~~

## 範囲変更(縦・横項目とデータが離れている場合)
~~~visualbasic
Dim start As Variant
Dim end As Variant
start = "C"
finish = "F"
ActiveSheet.ChartObject("Graph Name").Active
ActiveChart.SetSourceData Union(Range("A1"), Range(start & 1, finith & 1), Range("A7:A10"), Range(start & 7, finish & 10))
~~~

## 幅変更
~~~visualbasic
ActiveSheet.ChartObjects("Graph Name").Width = 1500
~~~



# ■ ワークシート操作

## 追加
~~~visualbasic
Worksheets.Add
~~~

## 任意位置へ追加
~~~visualbasic
Worksheets.Add Before:=Sheets("Sheet1")
~~~

~~~visualbasic
Worksheets.Add After:=Sheets("Sheet1")
~~~

## 削除
~~~visualbasic
ActiveSheet.Delete
~~~

# ■ ブック操作
## オープン
~~~visualbasic
Workbooks.Open Filename:="C:\test.xlsm"
~~~

## 新規オープン
~~~visualbasic
Workbooks.Add
~~~

## クローズ(保存なし)
~~~visualbasic
Workbooks("test.xlsm").Close SaveChanges:=False
~~~

## クローズ(保存あり)
~~~visualbasic
Workbooks("test.xlsm").Close SaveChanges:=True
~~~

# ■ ファイル操作
## フォルダ作成

~~~visualbasic
Mkdir "C:\temp"
~~~

## フォルダ削除

~~~visualbasic
RmDir "C:\temp"
~~~

## フォルダ移動

~~~visualbasic
Name ""C:\temp" As "C:\temp\works"
~~~

## フォルダ名変更

~~~visualbasic
Name "C:\temp" As "C:\works"
~~~

# ■ ハイパーリンク操作
## 指定セルのハイパーリンク実行
~~~visualbasic
Range("A5").Hyperlinks(1).Follow
~~~

## 選択中セルのハイパーリンク実行
~~~visualbasic
Cells(1, 5).Select
Selection.Hyperlinks(1).Follow
~~~

## 指定範囲中でのハイパーリンク実行
~~~visualbasic
Range(Cells(1, 5), Cells(1, 10)).Hyperlinks(1).Follow
~~~

## 指定セルのハイパーリンクのアドレス取得
~~~visualbasic
Range("A5").Hyperlinks(1).Address
~~~


# ■ エラー
## エラーを無視
~~~visualbasic
On Error Resume Next
~~~

## エラー種別取得
~~~visualbasic
On Error Resume Next
Sheets("Sample").Activate
If Err.Number > 0 Then
    MsgBox "異常"
Else
    MsgBox "正常"
End If
~~~

## エラー情報無効化
~~~visualbasic
Err.Clear
~~~

## エラー対応の終了
~~~visualbasic
On Error GoTo 0
~~~

## エラー発生後ラベルへジャンプ
~~~visualbasic
On Error GoTo errorEnd
'処理
errorEnd:
~~~

## ユーザ定義のエラー発生
~~~visualbasic
errNum = ActiveCell.Value
Select Case errNum
  Case CVErr(XlErrNull)
    ' error handling operations for #NULL!(2000)
  Case CVErr(xlErrDiv0)
    ' error handling operations for #NULL!(2007)
  Case CVErr(xlErrName)
    ' error handling operations for #NAME?(2029)
  Case CVErr(XlErrNA)
    ' error handling operations for #N/A(2042)
End Select
~~~

# ■ Sleep
## API宣言
~~~visualbasic:32bit
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
~~~
~~~visualbasic:64bit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
~~~

## Sleep実行
~~~visualbasic
sleep 1000 '1秒スリープ
~~~

# ■ withステートメント

~~~visualbasic
With ActiveSheet.Range("A1")
    .Value = "test"
    .Font.Color = RGB(255, 0, 255)
End With
~~~

# ■ コメント
~~~visualbasic
' comment
~~~

# ▽▽▽▽ IE操作編  ▽▽▽▽

# ■ 参照設定
## InternetExplorer型追加
VBE起動 → ツール → 参照設定 → Microsoft Internet Controlsをチェック → OK

# ■ IE操作
## IE起動 & WEBページ移動 & IE終了

~~~visualbasic
Dim ie As InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate "任意のURL"

'### WEBページへアクセス完了待ち処理(略) ###

Dim htmlDoc As HTMLDocument
Set htmlDoc = ie.document

ie.Quit
~~~

## 前のページへ移動
~~~visualbasic
Dim ie As InternetExplorer
'###  ieアクセス処理(略) ###
ie.GoBack
~~~

# ■ textareaタグ操作

## id/name属性で検索 & 値を入力

~~~visualbasic
Dim textAreaElem As HTMLTextAreaElement

Set textAreaElem = htmlDoc.getElementById("SearchWord")
textAreaElem.Value = "InputData"

Set textAreaElem = htmlDoc.getElementByName("SearchWord")(1) 'name属性はIndex#指定要
textAreaElem.Value = "InputData"
~~~

# ■ inputタグ操作

## name属性で検索 & クリック

~~~visualbasic
Dim inputElem As HTMLInputElement

Set inputElem = htmlDoc.getElementsByClassName("SearchWord")(1)
inputElem.Click
'### WEBページへアクセス完了待ち処理(略) ###
~~~

## tag名とsrc属性で検索 & クリック

~~~visualbasic
Dim inputElem As HTMLInputElement

For Each inputElem In htmlDoc.getElementsByTagName("INPUT")
    If InStr(inputElem.src, "SearchFile.png") > 0 Then
        inputElem.Click
        '### WEBページへアクセス完了待ち処理(略) ###
        Exit For
    End If
Next
~~~

## tag名とvalueプロパティで検索 & クリック

~~~visualbasic
Dim inputElem As HTMLInputElement

For Each inputElem In htmlDoc.getElementsByTagName("INPUT")
    If InStr(inputElem.Value, "SearchWord") > 0 Then
        inputElem.Click
        '### WEBページへアクセス完了待ち処理(略) ###
        Exit For
    End If
Next
~~~

# ■ imgタグ操作

## tag名とsrc属性で検索 & alt取得 & クリック

~~~visualbasic
Dim htmlImg As HTMLImg

For Each htmlImg In htmlDoc.getElementsByTagName("IMG")
    If InStr(htmlImg.src, "SearchFile.png") > 0 Then
        Cells(1, 1) = htmlImg.alt
        htmlImg.Click
        '### WEBページへアクセス完了待ち処理(略) ###
        Exit For
    End If
Next
~~~

# ■ anchorタグ操作

## id属性で検索 & クリック

~~~visualbasic
Dim anchorElem As HTMLAnchorElement

Set anchorElem = htmlDoc.getElementById("SearchWord")
anchorElem.Click
'### WEBページへアクセス完了待ち処理(略) ###
~~~

## Tag名とinnerTextプロパティで検索 & クリック

~~~visualbasic
Dim anchorElem As HTMLAnchorElement

For Each anchorElem In htmlDoc.getElementsByTagName("A")
    If InStr(anchorElem.innerText, "SearchWord") > 0 Then
        anchorElem.Click
        '### WEBページへアクセス完了待ち処理(略) ###
        Exit For
    End If
Next
~~~

# ■ divタグ操作
## クラス名で検索 & 値取得
~~~visualbasic
Dim divElem As HTMLDivElement
Dim text As String

For Each divElem In htmlDoc.getElementsByClassName("SearchWord")
  text = divElem.innerText
  Exit For
Next
~~~

## クラス名で検索 & divタグ内の最初のanchorタグをクリック
~~~visualbasic
Dim divElem As HTMLDivElement

For Each divElem In htmlDoc.getElementsByClassName("SearchWord")
  divElem.getElementsByTagName("A")(0).Click
  '### WEBページへアクセス完了待ち処理(略) ###
  Exit For
Next
~~~

# ■ tableタグ操作
## TH名で検索 & TDタグ取得
~~~visualbasic
Dim cnt As Integer
    
For cnt = 0 To htmlDoc.all.Length - 1
   If htmlDoc.all(cnt).tagName = "TH" Then
       If htmlDoc.all(cnt).innerText = "SearchWord" Then
           AppActivate Application.Caption
           Cells(1, 1) = htmlDoc.all(cnt + 1).innerText
           Exit For
       End If
   End If
Next cnt
~~~

## TDタグで検索 & TDタグ内の最初のimageタグのsrc名を取得
~~~visualbasic
Dim cnt As Integer

For cnt = 0 To htmlDoc.all.Length - 1
    If htmlDoc.all(cnt).tagName = "TD" Then
        Cells(1, 1) = htmlDoc.all(cnt).getElementsByTagName("IMG")(0).src
        Exit For
    End If
Next cnt
~~~


# ■ VBSからVBAマクロ起動

~~~visualbasic
Dim searchName
Dim searchExtension
Dim objExcel
Dim objPath
Dim objFso
Dim file
Dim IngPos
Dim Book0
Dim excelbook
Dim xlsxName


searchName = “searchword”
searchExtension = “csv”
Set objExcel = CreateObject(“Excel.Application”)
Set objPath = CreateObject(“Scripting.FileSystemObject”).GetFolder(“.”)
Set objFso = CreateObject(“Scripting.FileSystemObject”)

objExcel.Visible = False
ObjExcel.DisplayAlerts = False

objExcel.Workbooks.Open objPath & macro_templete.xlsm

For Each file In objPath.Files
  IngPos = Instr(file.Name, searchName)
  If IngPos > 0 Then
    IngPos = Instr(file.Name, searchExtension)

    If IngPos > 0 Then
      Set excelbook = objExcel.Workbooks.Open(objPath & “\” & file.name, 1)
      xlsxName = ojbFso.GetBaseName(objPath & “\” & file.name) & “xlsx”
      excelbook.SaveAs objPath & “\” & xlsxName, 51
      objExcel.Run “‘” & objPath & “\macro_template.xlsm” & “‘!format_macro”
    Else
    End If
  Else
  End If
Next

WScript.sleep(1000)

For Each Book0 in objExcel.workbooks
  If Book0.saved = vbfalse Then Book0.save
  Book0.close
Next

objExcel.Quit
Set objExcel = Nothing

WScript.Quit

~~~