最近、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