VBAメモ帳

～目次～

コード一覧　（操作系）

アプリケーションの表示/非表示

Application.Visible = True / Application.Visible = False

ブックの保存（上書き・新規）

ActiveWorkbook.save Activeworkbook.saveAs Filename:=XX,_ FileFormat:=xlopenXMLWorkbook,Password:="XXX",_ ReadOnlyRecommended:=False,CreateBackup:=False

ブックを閉じる

ActiveWorkbook.Close /Windows(ファイル名).Close

ブックの保護・解除

ActiveWorkbook.Protect Structure:=True,Windows:=False,Password:="XXX" ActiveWorkbook.Unprotect Password:="XXX"

ワークシートの表示・非表示

Worksheets("XXX").Visible=True / False

警告の表示・非表示

Application.DisplayAlerts=False / True

画面更新のオン・オフ

Application.ScreenUpdating=False / True

印刷ダイアログ

Application.Dialogs(xlDialogPrinterSetup).Show

印刷（アクティブシートの印刷）

ActiveSheet.PrintOut

印刷（選択シートの印刷：previewあり）

Sheets("XXX").PrintPreView

ファイルダイアログの表示

With Application.FileDialog(msoFileDialogFilePicker)

 if.show = True Then

  XXX=.SelectedItems(1)

 End if

End With

フォルダダイアログの表示

With Application.FileDialog(msoFileDialogFolderPicker)

 if.show = True

  Then XXX=.SelectedItems(1)

 End if

End With

同じファイルが同じディレクトリにないか確認

If Dir(そのファイルのディレクトリ)<>"" Then

 ある場合

Else

 ない場合

End if

エクセル関数を利用する

Appplication.WorksheetFunction.関数≪Round,Rounddown,Roundup,CountAなど≫

セルにコメントを入れる

Range()のときとの違いに注意！

addコメントはすでにコメントがあるとエラーになるので事前に.Clearcommentsで消して追加するようにしましょう。

with cells( , )
 .Addcomment
 .Comment.Visible = False
 .Comment.Text = Text:=""
End with

複数シートの選択

Sheets(Array("シート名A","シート名B")).Select

アドインのツールバー追加（プロジェクトのPWロックをした状態でツールバーに表示が可能）

Private Sub Workbook_AddinInstall()

 Dim A As CommandBar

  Set A = Application.CommandBars("Worksheet Menu Bar")

  Application.CommandBars.add(["Worksheet Menu Bar",,,FALSE])←FALSEを指定するとエクセルを閉じても消えません。

  Dim B As CommandBarControl

   Set B=A.Controls.Add(Type:=msoControlButton)

    B.Style = 3　（←1：アイコンのみ　2：テキストのみ　3：両方）

    B.Caption = "何かテキスト"

    B.TooltipText = ""　　←アイコンの説明

    B.FaceId = 数字　標準アイコンのIDを入力

    B.OnAction = "XXXX" ←起動する標準モジュール名を記入

 End Sub

次にブックを閉じるときにアイコンを削除する処理を行います。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

 Dim A As CommandBar

  Set A = Application.CommandBars("Worksheet Menu Bar")

 Dim B As CommandBarControl

  Set B = A.Controls.Add(Type:=msoControlButton)

  For Each B In A.Controls

    B.Delete

  Next B

End Sub

最後に、ブックを開いたときにアイコン表示のコードを呼び出すように以下の処理を行います。

Private Sub Workbook_Open()
 Call Workbook_AddinInstall
End Sub

あとは標準モジュールで以下を記載すればフォームが開く

Sub XXXX()
 UserForm1.Show
End Sub 　

アドイン化して配布すればツールバーにアイコンができて、

それを押すだけでユーザーフォームやマクロが実行可能に。

別のフォームに値を渡す

userform1の中で以下を指定します。 　

  userform2.label="ABC"

  userform2.show

別のモジュールに値を渡す

Dim X as 型

Call A(X)　Aのプロシージャを呼び出す際にXの値を渡します。

・・・

Sub A(ByVal　X　as 型) 　元の変数の値を変更しない値渡し。

・・・

Sub A(ByRef  X  as 型) 　元の変数の値を変更する。参照渡し 。

コード一覧　（処理系）

エラー発生時の防止処理

On error GoTo X

/////コード

Exit Sub

X:　　←ここに飛びます

End Sub

処理無効(中断)　On error GoTo 0

処理無視継続　On error Resume Next

処理待ち時間を発生させる

待　= DateAdd("S",50,Now())

Do While

Now()< 待 　

DoEvents 　

Loop

乱数を一定の範囲で生成する

Randomize   ←この文字でクリア（ルーレットスタートのイメージ）

乱数=Int((50 -1 +1 )*Rnd +1)   →#1から50の間の数字

フォルダ内のデータ検索（エクセルの場合）

Fl = "C:\Users\デスクトップ"  'フォルダのディレクトリを指定します。
    Flnm = Dir(Fl & "\*.xlsx")　'エクセルだった場合
    Do While Flnm <> ""
           If Flnm = BN Then
            GoTo YU
            Else: End If
            
           If Right(Flnm, 10) <> "12345.xlsx" Then 'ファイル名の一致のためライト関数やレフト関数の数字に注意
            GoTo YU
            Else: End If

IU = Split(Flnm, "\") '最終の項目はファイル名なのでファイル名を取得することができます。
For j = 0 To UBound(IU)
Fname = IU(j)
Next j

Workbooks.Open Filename:=Fl & "\" & Flnm　　　'あとは開きましょう。

Workbooks("ファイル名").Save　　　　　　　　　　　　　　 '上書き保存
Workbooks("ファイル名").Close　　　　　　　　　　　　　　'閉じる
Workbooks("ファイル名").SaveAs パスとファイル名.拡張子  '新規保存 

YU:
     Loop

CSV・text(カンマ区切り)　操作

【入力】

Open "ディレクトリ" For Input As #10 　→＃番号はファイル番号　読み込むときはInputを使います。

Do　Until　EOF(10) 　　　　　　　　　　→EOF関数は最終行に達したらTrueを返す

Line input #10,変数　　　　　　　　　　→Line input は一行ずつ返すo

Loop

Close #10

【出力】

Open "ディレクトリ" For Append As #10　

　　 　　　　→Append：すでにある内容に追加　

　　　　　　　output:既にあるものはすべて削除し最初から入力

　　　　　　→Openはその指定場所にファイルがないと新たに作成します。

Print #10,書き込むデータ　 　　　　

　　　　　　→改行が必要な場合は　(vbCrLf,vbCr,vbLf)を利用

Close #10

対象文字の列・行番号検索

一行目のXXXの列

Sheets(X).Rows(1).Find(WHAT:="XXX",Lookat:=xlwhole).column

一列目のXXXの行

Sheets(X).columns(1).Find(WHAT:="XXX",Lookat:=xlpart).Row

→全一致　Lookat:=xlwhole 　→部分一致　Lookat:=xlpart

レジストリにデータを保存・読込・削除

【保存】

SaveSetting Appname,section,key,string

→例えば　Appnameが”A” sectionが”B” keyが”C” stringが”テスト”の場合 　

　Aというフォルダ内のBフォルダ内のCのデータの値がテストという文字になる

【読込】

変数=Getsetting(Appname,section,key)

＜複数読み込みの場合＞

変数=Getsetting(Appname,section)

　For n = 0 to UBound(変数） →UBound()は最大要素数を返す。最小はLBound() 　　　

　　key=変数(n,0)

　　string=変数(n,1)

　next n

【削除】

keyを削除

DeleteSetting Appname,section,key

section配下のデータをすべて削除

DeleteSetting Appname,section

Appname配下のデータを削除

DeleteSetting Appname　

スプリット関数

X=Split("あ,い,う,え,お",",")

tab区切りを分割する→chr(9)を使います。　VBCRLFはChr(13) & Chr(10) キャリッジリターン&ラインフィード

X(0) は”あ”　X(1)は”い”

要素ごとに分解する場合はUBound()とFor を使うと便利

For i = 0 to UBound(X)

値= X(i)

Next i

リプレイス関数

Replace(変数（文字列）, "X", "Y")

X:探す文字

Y:置き換える文字

Chr（）の種類

文字が何個含まれているか確認する

NX = 0
Do
N=InStr(N + 1,変数（文字列）, "X")
 If N = 0 Then
   Exit Do
 ELse
   NX = NX + 1
 End if
Loop

N:あったら、その文字の場所（何文字目か）を返すので、０以外の個数をDo Loopで繰り返し数えます。

X:探す文字

指定した文字種類に変更する

N=format(X,"0000")

 xが1の場合 nは”0001″

日にち関係の処理

閏年かのチェック ＊Yは変数で年（yyyy）を入力

If Day(DateSerial(Y, 3, 1) - 1) = 29 Then

閏年の場合

else

閏年でない場合

End If

曜日の確認

値＝Weekday(”yyyy”& "/" & ”㎜” & "/" & "dd")

　→1：日曜日 　2：月曜日 　3：火曜日 　4：水曜日 　5：木曜日 　6：金曜日 　7：土曜日

曜日名＝WeekdayName(”yyyy”& "/" & ”㎜” & "/" & "dd")

期間の計算1

日数 = (DateSerial((”yyyy”,”㎜”,"dd") + 1) - DateSerial(”yyyy”,”㎜”,"dd"))

期間の計算2 

年数後（ﾏｲﾅｽだと前）= DateAdd("yyyy", 年数,”yyyy”& "/" & ”㎜” & "/" & "dd") 　

月数後（ﾏｲﾅｽだと前）= DateAdd("m", 月数,”yyyy”& "/" & ”㎜” & "/" & "dd") 　

日数後（ﾏｲﾅｽだと前）= DateAdd("ｄ", 日数,”yyyy”& "/" & ”㎜” & "/" & "dd")

期間の計算3 

年単位＝DateDiff（”yyyy”，開始年月日，終了年月日） 　

月単位＝DateDiff（”m”，開始年月日，終了年月日） 　

日単位＝DateDiff（”d”，開始年月日，終了年月日）

西暦から和暦へ

ye="yyyy"

mo = "mm"

da = "dd"

Select Case ye'大正、明治は割愛

　Case Is < 1989 　

　　元号 = "昭和" 　

　　和暦 = ye - 1925

　Case Is = 1989

　　If mo = 1　Then

　　　If da <= 7 Then

　　　　元号 = ”昭和”

　　　　和暦 = ye - 1925

　　　Else

　　　　元号 = ”平成”

　　　　和暦 = 1

　　　End If

　　Else

　　End If

　Case 1990 To 2018

　　元号 = ”平成”

　　和暦 = ye - 1988

　Case Is = 2019

　　If mo <= 4 Then

　　　元号 = ”平成”

　　　和暦 = ye - 1988

　　Else

　　　元号 = ”令和”

　　　和暦 = 1

　　End If

　Case Is > 2019

　　元号 = ”令和”

　　和暦 = ye - 2018

End Select 

フォーム上でマウスドラックした際の座標取得

マウスで＜Target＞というラベルやボタンなどをクリックしてフォーム上で動かすとそのオブジェクトの位置を変更します。

Option Explicit
Private pX As Single 'Xはフォームの横軸
Private pY As Single 'Yはフォームの縦軸

Private Sub Target_MouseDown(ByVal Btn As Integer,ByVal Shift As Integer,ByVal X As Single,ByVal Y As Single)
'左クリックをすると1 右クリックをすると2を値で返す。
If Btn = 1 Then
'クリック位置の保存
　pX = X
　pY = Y
End If
End Sub


Private Sub Target_MouseMove(ByVal Btn As Integer,ByVal Shift As Integer,ByVal X As Single,ByVal Y As Single)
'左クリックの検出
If Btn = 1 Then
'マウスが移動した分コントロールを移動
　With Target
　　.Top = .Top + Y - pY
　　.Left = .Left + X - pX
　End With
End If
End Sub

Beep音を出す

Option Explicit
Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Sub a()
Call Beep(9999, 2000) 
End Sub

Beep(音色440Hz以下は低すぎて聞こえない9999Hzは高い音　,　時間1000＝1秒)

WEB操作（Internet Explorer）＊IEはサービス終了になりました。

事前に開発タブ－VB－ツール－参照設定で

①Microsoft HTML Object Library
②Microsoft Internet Controls

にチェックを入れる

オートメーションエラーが表示される場合は

Internet Explorerのインターネットオプションで〈保護モードを有効にする〉のチェックを入れます。

#InternetExplorerで開いたWebページの入力操作を行う（文字情報の読み込みは別途手を加える必要があります。）

Dim IE As InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
 IE.Visible = True
 IE.Navigate "https://　～”
 待ち時間 = DateAdd("Ｓ", 3, Now())
  Do While Now() < 待ち時間
    DoEvents
  Loop

For Each objTag In IE.document.getElementsByTagName("input") 

基本は　type横の種類（タグ名）を入力してください。
→("select")・・・ラジオボタン
→("textarea")・・・複数行テキストBOX


If InStr(objTag.outerHTML, "X") > 0 Then 
 ←XはWEBサイトの要素にあるものでALTの文字列やname=の文字で可（要素内で完全にヒットする文字列がベスト。）

＜ボタンをクリック、チェックボックスにチェックを入れる場合＞
objTag.Click
＜エントリーBOXへの入力の場合＞
objTag.Value = X
＜ラジオボタンの場合＞
objTag.Value =番号

Exit For
End If
Next

WEB操作（Chrom seleniumBasic利用）

seleniumBasicをインストール（開発者に敬意を表して）

https://github.com/florentbr/SeleniumBasic/releases/tag/v2.0.9.0

インストールした場所のChromdriver.exeの更新（以下より最新のものをダウンロード）

https://sites.google.com/a/chromium.org/chromedriver/home

Excel＞VBE＞ツール＞参照設定＞selenium type library にチェック

#WEB操作
Dim d As New ChromeDriver　　
　　→IEDriver でIEの操作も可能
d.Get ("https://～）
<クリック・チェックボックスやラジオボタンにチェック>
d.FindElementByCss(X).Click
<WEBページのテキストを取得>
Y = d.FindElementByCss(X).Text
<インプットボックスに入力>
d.FindElementByCss(X).SendKeys "ZZZ"
<コンボボックスに入力>
d.FindElementByCss(X).SendKeys "Valueの値"

画面遷移し遷移した先の情報を参照する場合は以下の内容を入力
d.SwitchToNextWindow

インラインフレーム（ページの中に別のページがある場合）
d.SwitchToFrame

Xは画面上で右クリック＞検証＞対象のエレメントで右クリック＞Copy＞Copy selector　の値を使用します。


d.wait 5000   ←5秒　　20000　←20秒

d.Quit

OneDriveを参照する

共有ファイルサーバーと違いOneDriveのパス参照は少し厄介です。

以下はOneDriveを同期していることを前提として記載します。

●他人のOneDriveの共有フォルダを使う

　OneDriveの自分のファイルにショートカットをします。

●SharePointを使う

　OneDriveの自分のファイルにショートカットを作る。

上記の設定でエクスプローラーからアクセスできるようになるのでパスを取得することで参照が可能になります。

そのほか

　OneDriveのパスの先頭を取得する際は

Environ（”OneDrive”）

Environ（”OneDrive commericial”）

を利用すれば取得できる。