VBA

※主にExcelVBA

他ブックのマクロを呼び出す

ファイル名と関数名があれば呼び出せる
Application.Run "hoge.xls!Test"

ADO接続

' 参照設定「Microsoft Active Data Object 2.x Library」
Private Sub ADO_test()

  ' 参照設定「Microsoft Active Data Object 2.x Library」
   Dim dbCon As New ADODB.Connection
   Dim dbRes As New ADODB.Recordset
   Dim dbCols As ADODB.Fields
   Dim strSQL As String
   Dim rowIndex As Long

  dbCon.Open "Provider=SQLOLEDB;Server=sd2_sv5;User id=IMS;Password=IMS;Initial Catalog=IMS;"
   
   ' SQL - SELECT文
   strSQL = "SELECT * FROM M_SYSTEM"
   dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
   
   rowIndex = 1
   Do Until dbRes.EOF
       rowIndex = rowIndex + 1
       Set dbCols = dbRes.Fields
       Debug.Print "システムNO:" & dbCols("SYSTEM_NO").Value
       Debug.Print "システム名:" & dbCols("SYSTEM_NM").Value
       Debug.Print "サブシステム名:" & dbCols("SUB_SYSTEM_NM").Value
       Debug.Print "--------------------"
       dbRes.MoveNext
   Loop
   
   dbRes.Close
   Set dbRes = Nothing
   dbCon.Close
   Set dbCon = Nothing

End Sub

シートコピー

シートコピーは使わないようにする。
※突然動かなくなるなる不具合あり
使う場合はシート追加をして、全セルコピペにすること。

スクロールバーの移動

ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1

左パッディング

Function PadLeft(ByVal expression As String, ByVal padding As String, ByVal length As Integer) As String
  Dim replaceLength As Integer
   replaceLength = length - Len(expression)
   PadLeft = String(replaceLength, padding) & expression
End Function

保存確認を出したくない

Application.DisplayAlerts = false
ThisWorkbook.Saved = true ' これも必要
Application.Quit
Application.DisplayAlerts = true

データ型

バイト型 Byte 1 0~255
ブール型 Bool 2 真(True)偽(False)
整数型 Integer 2 -32,768~32,767
長整数型 Long 4 -2,147,483,648~2,147.483,647
単精度浮動小数点数型 Single 4 -3.402823E38~-1.401298E-45(負の数)1.401298E-45~3.402823E38(正の数)
倍精度浮動小数点数型 Double 8 -1.7976931348623E308~-4.94065645841247E-324(負の数)4.94065645841247E-324~1.79769313486232E308(正の数)
通貨型 Currency 8 -922,337,203,685,477.5808~922,337,203,685,477.5807
日付型 Date 8 西暦100年1月1日~西暦9999年12月31日
オブジェクト型 Object 4 オブジェクトを参照するデータ型
文字列型 String 10+文字列の長さ 0~2GB
バリアント型 Variant 16 すべてのデータを扱えるデータ型で0~2GB

ファイル数取得

(拡張子指定なし)
Function GetFileCount(ByVal DirPath As String) As Long
  
   Dim fileName As String
   Dim fileCount As Long
   
   If Right(DirPath, 1) <> "\" Then
       DirPath = DirPath + "\"
   End If
   fileName = Dir(DirPath + "*.*")
   
   fileCount = 0
   Do While fileName <> ""
       fileCount = fileCount + 1
       fileName = Dir()
   Loop
   
   GetFileCount = fileCount
End Function

改行コード

Chr(13) & Chr(10)

SaveAsが成功したかどうか

On Error Resume Nextを付けておいて、保存後
Err.Number が 0 なら成功、それ以外は失敗(キャンセル)

ユーザフォームのコントロールの種類を判別

if TypeName(c) = "CheckBox" then ' チェックボックスか判別

フォームのエディットボックス

シートの挿入で[ダイアログ]を選択すると、そのシート上にエディットボックスを配置できる。
これを普通のシートにもコピーできる。

×ボタン抑止

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  ' ×ボタン無効
   If CloseMode = vbFormControlMenu Then
       Cancel = True
   End If
End Sub

切捨て

Debug.Print Int(x)

丸め

Debug.Print fix(x)
近い偶数に丸める

文字変換

strcnv(文字列式, 変換形式)
定数 内容
vbUpperCase 1 大文字に変換
vbLowerCase 2 小文字に変換
vbProperCase 3 各単語の先頭の文字を大文字に変換
vbWide 4 半角文字を全角文字に変換
vbNarrow 8 全角文字を半角文字に変換
vbKatakana 16 ひらがなをカタカナに変換
vbHiragana 32 カタカナをひらがなに変換
vbUnicode 62 システム既定のコードページを使って文字列をUnicodeに変換
vbFromUnicode 128 文字列をUnicodeからシステム既定のコードページに変換

文字コード

ダブルコーテーション(") → Chr(&H22)

シートに動的にボタンを追加 & イベントを追加

Sub AddButtons()
  With ActiveSheet.Buttons.Add(10, 10, 30, 30)
          .Name = "Buttons" & .Index
          .Caption = "ボタン"
          .OnAction = "Button_clicked"
   End With
End Sub

Public Sub Button_clicked()
Dim btn As Variant
Dim myChkBox As Object
Dim i As Integer
btn = Application.Caller
 If Not IsError(btn) Then
   Dim myButton As Object
   Debug.Print ActiveSheet.Buttons(Application.Caller).Caption    'Captionを表示
   Debug.Print ActiveSheet.Buttons(Application.Caller).Name       '名前を表示
 End If
End Sub

マクロからフォームのコントロールを操作

例) チェックボックスの状態を取得
Dim check As CheckBoxes
Set c = ActiveSheet.CheckBoxes(1)
Debug.Print IIf(c.Value = xlOff, "OFF", "ON")

例) オプションボタン
Dim b As OptionButton
For Each b In OptionButtons
  Debug.Print b.Name & vbTab; b.Text
Next

例) ドロップダウン
  Dim c As DropDown
   Set c = ActiveSheet.DropDowns(1)
   c.AddItem "kome1"
   c.AddItem "kome2"
   c.ListIndex = 2
Debug.Print c.ListIndex

例) エディットボックス
Debug.print Shapes("Edit Box 1").OLEFormat.Object.Text

UBound

ある次元の要素数を取得

例)
Dim array(3, 5) As string
MsgBox UBound(array, 1) →結果:3
MsgBox UBound(array, 2) →結果:5

2次元配列

Dim array() as string
ReDim Preserve array(1 to 10, 1 to 30)
※多次元配列では最後の次元しか増やせない

アドインの関数呼び出し

Application.Run "'hoge.xla'!hoge"

パス

Application.Path(エクセル本体のパス)
ThisWorkbook.Path(コードが記述されたブックのパス)
ThisWorkBook.FullName(コードが記述されたブックのフルパス)

特殊パス
例)
Set obj = CreateObject("Scripting.FileSystemObject")
filename = obj.GetSpecialFolder(2)
0 Windowsフォルダ
1 Systemフォルダ
2 Tempフォルダ

配列

↓配列の宣言
Dim vArray() As Variant
ReDim vArray(range.Rows.count, range.Columns.count)
↑配列のサイズ変更

メッセージボックス

例)result = MsgBox(msg, 1, caption)

パラメータ
省略:<OK>ボタンのみ表示
0:<OK>と<キャンセル>
1:<中止>、<再試行>、<無視>
2:<はい>、<いいえ>、<キャンセル>
3:<はい>、<いいえ>
4:<再試行>、<キャンセル>
5:警告メッセージアイコンを表示
16:問い合わせメッセージアイコンを表示
32:注意メッセージアイコンを表示
64:情報メッセージアイコンを表示

戻り値
1:<OK>
2:<キャンセル>
3:<中止>
4:<再試行>
5:<無視>
6:<はい>
7:<いいえ>

イベントを発生させたくない

APPlication.enableEvent = falseで、イベントが発生しなくなる。適時trueに戻すこと。

ソースをがっと出力


Sub subExportAllModuleforAccess()
  Dim vbcComp As VBIDE.VBComponent
   For Each vbcComp In Application.VBE.ActiveVBProject.VBComponents
      Debug.Print vbcComp.Name, vbcComp.Type
      vbcComp.Export ("c:\temp\" & vbcComp.Name)
   Next vbcComp
End Sub
※参照設定で「Microsoft Visual Basic Application Extensibility」を追加する

覚書

  • On Error Resume Next
  • グループ化するとコントロールを操作できなくなるんだけど。。

  • 最終更新:2012-06-26 11:12:15

このWIKIを編集するにはパスワード入力が必要です

認証パスワード