VBAマクロ

Last-modified: 2024-04-08 (月) 17:26:42
amazon.gif

設定

  • 型のサイズ
    データ型サイズ範囲
    バイト型Byte10～255
    ブール型Bool2真（True）偽（False）
    整数型Integer2-32,768～32,767
    長整数型Long4-2,147,483,648～2,147.483,647
    単精度浮動小数点数型Single4-3.402823E38～-1.401298E-45(負の数)1.401298E-45～3.402823E38（正の数）
    倍精度浮動小数点数型Double8-1.7976931348623E308～-4.94065645841247E-324（負の数）4.94065645841247E-324～1.79769313486232E308（正の数）
    通貨型Currency8-922,337,203,685,477.5808～922,337,203,685,477.5807
    日付型Date8西暦100年1月1日～西暦9999年12月31日
    オブジェクト型Object4オブジェクトを参照するデータ型
    文字列型String10+文字列の長さ0～2ＧＢ
    バリアント型Variant16すべてのデータを扱えるデータ型で0～2ＧＢ
  • 変数の強制宣言 参考 
    Option Explicit
     
  • 列をアルファベット表記から数字表示にする方法 
    Excel2019の場合
オプション　→　数式　→　R1C1方式にチェックをつける

表示

  • EXCELを非表示　（フォーム画面だけ表示する） 
    Application.Visible = False '見えなくする
     
  • ディスプレイの表示をとめる　（処理を早くさせる） 
    Application.ScreenUpdating = False　　  'Displayの表示を止める
Application.ScreenUpdating = True  　　'Displayの表示する
     
  • エラー・確認メッセージを出さない 
    Application.DisplayAlerts = False 　  ' 確認のメッセージ出さない(保存するかしないかなど)
Application.DisplayAlerts = True 　  '
     
  • マウスのカーソルの設定 
    Application.Screen.MousePointer = 11　'マウスを砂時計に切り替えます。
Application.Screen.MousePointer = 0   'マウスを元に戻します。
     

ウィンドウに表示されるビューを設定 

ActiveWindow.View = xlNormalView ' 標準表示

　xlNormalView ＝ 標準
　xlPageBreakPreview ＝ 改ページプレビュー
　xlPageLayoutView ＝ ページレイアウト

 

セルを最適なサイズで表示する設定 

Columns("A:E").AutoFit ' A→E列のセルの幅を自動調整
Columns.AutoFit ' 全列のセルの幅を自動調整

文字：色をつける 

' 例：青色を付ける
Range("B2").Font.ColorIndex = 3     ''色パレットの3番を設定します
Columns(52).Font.Color = RGB(0, 0, 255)  ''青色に設定します

セルの背景：色をつける 

' 例：青色を付ける
Range("B2").Interior.Color =vbyellow      '黄色)を設定します
Columns(52).Interior.Color = RGB(0, 0, 255)  ''青色に設定します

ウィンドウ枠の固定 

   ' ウィンドウ枠の設定
   dim ShName as string
   ShName = "TestSheets"
   ActiveWindow.FreezePanes = False　’ウィンドウ枠の解除
   Worksheets(ShName).Rows(3).Select　’3行目を選択
   ActiveWindow.FreezePanes = True ' ウィンドウ枠の設定

枠線を引く 

A1からV(k-1)の範囲で枠線を引く
'枠線の設定
   With Sheets(ShName).Range("A1:V" & k - 1)
       '①上部
       .Borders(xlEdgeTop).LineStyle = xlContinuous
       '②左
       .Borders(xlEdgeLeft).LineStyle = xlContinuous
       '③下部
       .Borders(xlEdgeBottom).LineStyle = xlContinuous
       '④右
       .Borders(xlEdgeRight).LineStyle = xlContinuous
       '⑤範囲内の縦線
       .Borders(xlInsideVertical).LineStyle = xlContinuous
       '⑥範囲内の横線
       .Borders(xlInsideHorizontal).LineStyle = xlContinuous
   End With
 

枠線を色を付ける 

A1からV(k-1)の範囲で赤枠線を引く
'枠線の設定
   With Sheets(ShName).Range("A1:V" & k - 1)
       '①上部
       .Borders(xlEdgeTop).colorindex = 3 ' 赤枠線
       '②左
       .Borders(xlEdgeLeft).colorindex  = 3 ' 赤枠線
       '③下部
       .Borders(xlEdgeBottom).colorindex  = 3 ' 赤枠線
       '④右
       .Borders(xlEdgeRight).colorindex  = 3 ' 赤枠線
       '⑤範囲内の縦線
       .Borders(xlInsideVertical).colorindex  = 3 ’赤枠線
       '⑥範囲内の横線
       .Borders(xlInsideHorizontal).colorindex  = 3 ’赤枠線
   End With

参考

シート

シート・ブック・セル操作

  • Range　で　行・列に変数を使いたい場合 
    Range(i & ":" & i)  ' i 行全て
  • シートの存在確認 (サンプル) 
    Public Function Exist_Sheet(SheetName As String) As Integer
   Dim Ws As Worksheet
   Dim flag As Boolean
   For Each Ws In Worksheets
       If Ws.Name = SheetName Then
           flag = True
           Exit For
       End If
   Next Ws
   If flag = True Then
       Exist_Sheet = 1 '存在した
   Else
       Exist_Sheet = 0 ' 存在せず
   End If
End Function
     
  • シート挿入 (サンプル) 
    Worksheets.Add  ' シート挿入
ActiveSheet.Name = "シート22"
  • シートのコピー
    例、コピー先に同じ名前のシートがあると一度削除して、コピーしてシート名をリネームする。 
    Application.DisplayAlerts = False    ' 確認のメッセージ出さない
Worksheets("集計用3").Delete    ' シート削除
Application.DisplayAlerts = True   ' 確認のメッセージ出す
Sheets("集計用22").Copy Before:=Sheets("集計用22") ' 集計用22を集計用の前にコピー
ActiveSheet.Name = "集計用3"
  • セルのコピー 
    Ws22.Range(i & ":" & i).Copy Ws3.Range(j & ":" & j) ' Ws22のi行をWs3の行にコピー
  • 行の削除 
    ' 2 ～ 3 行目を削除
Range("2:3").Delete
Range("2:2", "3:3").Delete
Range(Rows(2), Rows(3)).Delete ' NG
Range("A2:A3").EntireRow.Delete
' 3 行目を削除
Rows(3).Delete
  • 行の削除<ループ処理での注意点>
    ループ処理で行削除をする場合は、上からではなく下から行う
    上から下だと正常に動かない 
    Dim Max_Row
Max_Row = ThisWorkbook.Worksheets(ShName).Range("a" & Rows.Count).End(xlUp).Row
For i = Max_Row To 2 Step -1
  FlagKoyou = Left(FlagKoyou, 2)
  If FlagKoyou = "10" Then
     Worksheets(ShName).Rows(i).Delete
  End If
Next i

ファイル・フォルダ

  • ファイルの存在確認 
    例.Dir(C:\Test.CSV) 存在しなければ空白を返す
     
  • フォルダの存在確認 
    例.Dir(C:\DATA,vbDirectory) 存在しなければ空白を返す
 
  • ファイル選択ダイアログ画面を開く(EXCEL用)
    ※　EXCELでしか使えない
    サンプル 
    Dim File As String
File = Application.GetOpenFilename( _
FileFilter:="テキストデータ,*.TXT" & _
　　",すべてのファイル(*.*),*.*" _
　　, FilterIndex:=0 _
　　, Title:="直送データを選択して下さい！")

※ VBAの参照設定で,Microsoft Office 12.0 Object Library　にチェックを入れる

 
  • フォルダのコピー　参考
    サンプルプログラム 
    Public sub DirectortCopy(FolderMoto as string,FolderSaki as String)
 Dim FSO As Object
 Set FSO = CreateObject("Scripting.FileSystemObject")
 FSO.CopyFolder FolderMoto,FolderSaki
 Set FSO = Nothing
End Sub
 

メール送信

メールのセキュリティが厳しくなっている中で、単純にVBAの基本機能だけでメール送信は難しくなってきている
SMTPリレー（中継）サーバをたてるなど、何らかの工夫が必要です。↓を紹介程度ですが実際に試したわけではないです。

メール系

関数

前０削除

Dim SyainNo as string
SyainNo = CStr(Val(SyainNo)
出力結果：例　00018 →　18
 

' 英字が存在するか？

　' 英字が存在したら-1を返す、
　’数字のみは数字に変換した結果を返す

Public Function HanteiSuji(Suji As String) As Integer
   Dim i As Integer
   For i = 1 To Len(Suji)
       If Mid(Suji, 1, 1) Like "[a-z]" Then
           HanteiSuji = -1
       End If
       If Mid(Suji, 1, 1) Like "[A-Z]" Then
           HanteiSuji = -1
       End If
   Next
   HanteiSuji = CStr(Val(Suji))
End Function

パスワード解析

  • EXCELのVBAマクロのパスワード解析ツール(正確には、パスワードを１にする)
    Office UnPassword of VBA　2003まで。2007?
 

中国語マクロ

中国のパソコンで、日本語で作ったマクロを動かす（中国のパソコンは日本語入力できる）

注意点：シート名、VBAマクロのコードは全てアルファベットで統一すること。
シート名の日本語は文字化けしないが、VBAのコードは文字化けしていた。
日本語と中国語の漢字の単語が同じでも文字化けするので。アルファベットで統一が無難。

またVBAの関数が外国では使えない場合もあるようだ。

ライセンス管理

参考サイト

サイト内リンク

マクロ系

その他

Office系

OS系