【VBA】いろいろ備忘録

最近、VBAで使ったネタを備忘録としてまとめておきます。

--

1.Worksheetにあるチェックボックスのステータスの一括確認する

複数存在するチェックボックスのステータス（True or False）を確認させる。
下記では、"True（チェックが入っている）"のもののカウントをさせている。

Sub Macro1()

    '変数定義
    Dim n, i, cnt

    'チェックボックスがTrue（チェックありもの）のカウントを行う
    With Worksheets("sheet1")
        For i = 1 To n
            If .OLEObjects("Checkbox" & i).Object.Value = True Then
                cnt = cnt + 1
            End If
        Next i
    End With

End Sub

--

2.チェックボックスのタイトル（Caption）を取得する

チェックボックスのタイトル（Caption）を取得させる。
連続した複数のタイトル（Caption）を取得する場合は、前述1を組み合わせる。

Sub Macro2()

    '変数定義
    Dim Caption

    'タイトル（Caption）を取得する
    Caption = Worksheet("sheet1").OLEObjects("Checkbox1").Object.Caption

End Sub

--

3.指定したアプリケーションを実行する

指定したアプリケーションを実行させる。

Sub Macro3()

    '指定したアプリケーションを実行させる（ex.メモ帳）
    Shell "notepad.exe"

End Sub

--

4.指定したアプリケーションをアクティブ表示する

指定したアプリケーションをアクティブ表示させる。

Sub Macro4()

    '指定したアプリケーションをアクティブ表示させる
    AppActivate "Microsoft Excel", True

End Sub

--

5.検索情報を取得する

指定した条件を満たす情報を任意のセルから取得させる。

Function get_info(info_name As String)

    '検索処理
    whr_info = serch_info(info_name)
    info = Worksheets("sheet1").Cells(whr_info, 1).Value

    '取得情報格納
    get_info = info

End Function

Function serch_info(name As String)

    '変数定義
    Dim lngYLine As Long
    Dim intXLine As Integer
    Dim Obj As Object

    '検索処理
    Set Obj = Worksheets("sheet1").Cells.Find(name, lookat:=xlWhole)
    If Obj Is Nothing Then
        MsgBox "Err_Not_Find...."
    Else
        lngYLine = Worksheets("sheet1").Cells.Find(name, lookat:=xlWhole).Row
        ingxline = Worksheets("sheet1").Cells.Find(name, lookat:=xlWhole).Column
    End If

    serch_info = lngYLine

End Function

--

6.指定秒数waitする

指定秒数waitさせる。

Sub Macro6()

    Application.Wait Now + TimeValue("00:00:10")

End Sub

--

7.指定したwindowがアクティブ表示させるまでループ

指定したwindowがアクティブ表示させるまでループさせる。

Sub Macro7()

    On Error Resume Next

    Do
        DoEvents
        Err.Clear
        AppActivate "notepad.exe"
    Loop While Err <> 0

End Sub

--

8.指定したアプリケーションのGUI操作する

指定したアプリケーションのGUI操作させる。

Sub Macro8()

    Shell "notepad.exe", True
    AppActivate "notepad.exe", True

    'フォント設定画面を開く
    SendKeys "%OF", True

End Sub