Edited at

【VBA】いろいろ備忘録

More than 1 year has passed since last update.

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