すぐに役立つエクセルVBAマクロ集 - Macro 開始終了・基本型

　　すぐに役立つエクセルVBAマクロ集 - すぐマク

Excel VBA Macro
Macro

500連発・組み方講座フォロー

Big Color Pallet

[広告]

Excel VBA Macro

Excel DownLoad

Sample Macro　　開始・終了 [基本型]

開始・終了 [基本型]

1) 開始処理
2) 現在の操作環境
3) 環境変数の値を取得する
4) パスを取得する
5) エラー対策
6) ファイル名を取得する
7) ファイル名や拡張子を変更する
8) ファイルのサイズと更新日時を取得する
9) 個人情報の削除可否を設定する
10) フォルダ名を取得する
11) 終了処理

1) 開始処理

'=========================================================================================
Sub 開始処理()
    Application.ScreenUpdating = False          '0)画面を更新しない
    ChDrive "C"                                 '1)指定ドライブへ切り替え ※１
    ChDir "\" & "FFF"                           '1)指定フォルダへ切り替え ※２
    Workbooks.Open FILENAME:="BBB" & ".xls"     '1)指定されたブックを開く ※３
    Sheets("SSS").Select                        '2)指定されたシートを選択 ※４
    Range("A1").Select                          '3)初期セルを選択する ※５
End Sub
'=========================================================================================

＜コメント＞
※１ Cにはフォルダが格納されているドライブを記入
※２ FFFにはブックが格納されているフォルダ名を記入
※３ BBBには開きたいブック名を記入、Openメソッドの引数はこちら
※４ SSSには開きたいシート名を記入
※５ A1にはあるセルを選択すると画面が一番整然と映るというセルを指定する。
　　ウインドウ枠が固定されたシートの場合は、非固定部分内の左上セルになります。

2) 現在の操作環境

'=========================================================================================
Public Function 操作環境についての情報()
    Range("C3").Formula = "=INFO(""release"")"  'INFO関数をセルにセットする ※２、３
    操作環境についての情報 = Range("C3").Value  '操作環境についての情報を取り出す ※２
End Function
'-----------------------------------------------------------------------------------------
Sub 操作環境についての情報を取得する()
    ワークシート関数式 = "=INFO(""release"")"   '※３
    MsgBox Evaluate(ワークシート関数式)
End Sub
'=========================================================================================

＜コメント＞
※１ Visual Basicから呼び出せないワークシート関数は、セルにセットして使います
※２ C3には関数をセットするセル名を記入
※３ "release" には検査の種類を記入（下表参照）

得られる情報	関数の書き方	備考
操作環境	=INFO("system")	Windows版：pcdos、Macintosh版：mac
OSのバージョン	=INFO("osversion")
Excelのバージョン	=INFO("release")
カレントフォルダのパス	=INFO("directory")
開かれているワークシート枚数	=INFO("numfile")
表示範囲の左上端セル	=INFO("origin")	先頭の「$A:」はLotus1-2-3互換のため
使用可能メモリ容量	=INFO("memavail")	単位：バイト
既使用メモリ容量	=INFO("totmem")	〃
データ使用中メモリ容量	=INFO("memused")	〃

サンプルブックのダウンロードはここをクリック　（YNxv201_kankyo.xls　74KB）
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。

3) 環境変数の値を取得する

'=========================================================================================
Sub 環境変数の値を取得する()
    名前 = "PATH"                               '環境変数の名前を指定 ※１
    MsgBox Environ(名前)                        '環境変数の値を取得できる
    番号 = 12                                   '環境文字列の番号を指定 ※２
    MsgBox Environ(番号)                        '環境変数の名前と値を取得できる
End Sub
'=========================================================================================

＜コメント＞
※１、２環境変数の番号、名前と値（=の左辺が名前、右辺が値の例）【Excel2003】

番号	名前と値(例)	番号	名前と値(例)
1	ALLUSERSPROFILE=C:\Documents and Settings\All Users
2	APPDATA=C:\Documents and Settings\Administrator\Application Data
3	CommonProgramFiles=C:\Program Files\Common Files	4	COMPUTERNAME=JISAKU2004A
5	ComSpec=C:\WINDOWS\system32\cmd.exe	6	FP_NO_HOST_CHECK=NO
7	HOMEDRIVE=C:
8	HOMEPATH=\Documents and Settings\Administrator
9	LOGONSERVER=\\JISAKU2004A	10	NUMBER_OF_PROCESSORS=1
11	OS=Windows_NT
12	Path=C:\Program Files\Microsoft Office\OFFICE11\;C:\WINDOWS _ \system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem
13	PATHEXT=.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH	14	PROCESSOR_ARCHITECTURE=x86
15	PROCESSOR_IDENTIFIER=x86 Family 15 Model 2 Stepping 9, GenuineIntel
16	PROCESSOR_LEVEL=15	17	PROCESSOR_REVISION=0209
18	ProgramFiles=C:\Program Files	19	SESSIONNAME=Console
20	SystemDrive=C:	21	SystemRoot=C:\WINDOWS
22	TEMP=C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp
23	TMP=C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp
24	USERDOMAIN=JISAKU2004A	25	USERNAME=Administrator
26	USERPROFILE=C:\Documents and Settings\Administrator	27	WecVersionForRosebud.5B4=2
28	windir=C:\WINDOWS

(注) Excel2002、2000、97では 1:COMSPEC、2:PROMPT、3:TEMP、4:TMP、5:PATH、6:winbootdir、7:windir のみ

4) パスを取得する

'=========================================================================================
Sub パスを取得する()
    パス = ActiveWorkbook.Path                  'アクティブウィンドウのブックのパス ※１、2
    パス = ThisWorkbook.Path                    '実行中のマクロが記述されているブックのパス
    パス = Application.Path                     '現在のアプリ(Excel)へのパス ※１
    パス = Application.DefaultFilePath          '起動時のカレントフォルダ ※１
    パス = Application.StartupPath              '起動(XLStart)フォルダ) ※１
    パス = Application.LibraryPath              'アドイン(Library)フォルダ ※１
    パス = CurDir                               '現在のドライブのパス ※１
End Sub
'-----------------------------------------------------------------------------------------
Sub フルパスを取得する()
    フルパス = ActiveWorkbook.FullName          'フルパス（パス付ブック名）
End Sub
'-----------------------------------------------------------------------------------------
Sub パスセパレータを取得する()
    パスセパレータ = Application.PathSeparator  '現在システムで使用中のパスセパレータ
End Sub
'-----------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------
Sub パスを取得する()
    パス = Environ("windir")                    'Windowsフォルダ ※１、３
    パス = Environ("temp")                      'Tempフォルダ ※１、３
End Sub
'-----------------------------------------------------------------------------------------
Sub デスクトップのパスを取得する()
    パス = CreateObject("WScript.Shell").SpecialFolders("desktop") '※１
End Sub
'-----------------------------------------------------------------------------------------
Sub MyDocumentsのパスを取得する()
    パス = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") '※１
End Sub
'-----------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------
Sub パスを取得する()
    絶対パス = Application.UserLibraryPath      '自作のアドイン(Addins)フォルダ ※４
End Sub
'=========================================================================================

＜コメント＞
※１パス末尾の円記号 (\) とファイル名を含まない絶対パス
※２ ActiveWorkbook の代わりに Workbooks(1)のように書いても良い
※３ Environ関数の構文：　Environ({envstring | number })
　　 envstring は環境変数の名前、 number は環境文字列テーブル内の順番、共に省略可
※４パス末尾の円記号 (\) が含まれない場合がある

5) エラー対策

'=========================================================================================
Sub 予期せぬエラーへの対策()
    On Error GoTo エラー処理                    '※１ エラーが発生した時の飛び先
    試し = Dir("A:\無い名前.xls")               '※２ わざとエラーを発生させるための例示
    Exit Sub                                    '※３ 正常終了
エラー処理:                                     '※３ エラーが発生した時の入り口
    MsgBox "作業を中止します。原因を取り除いてから、やり直してください。", _
    vbCritical, "予期せぬエラーが発生しました ... " & Str(Err) & ": " & Error(Err)
    Application.DisplayAlerts = False           '※３ 閉じる際に確認メッセージを出さない
    Close                                       '※３ ファイルをすべて閉じる
    Application.Quit                            '※３ エクセルを終了する
End Sub
'=========================================================================================

＜コメント＞
※１本来の処理の先頭に記述する
※２ここで本来の処理を記述する
※３本来の処理の末尾に記述する
※４エラー番号の一例

番号	メッセージ	番号	メッセージ	番号	メッセージ
7	メモリが足りません	11	0で除算しました	13	型が一致しません
18	ユーザー割り込みが発生しました	53	ファイルが見つかりません	57	デバイスI/O(入出力)エラーです
68	デバイスが準備されていません	70	書き込みできません	71	ディスクが準備されていません

6) ファイル名を取得する

'=========================================================================================
Sub ユーザーが選択したファイル名を取得する()
    初期表示パス = "C:\"                        '※１
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "ファイルを選択して [OK]をクリックしてください。"
        .InitialFileName = 初期表示パス
        .AllowMultiSelect = False
        .Show
        MsgBox .SelectedItems(1)
    End With
End Sub
'-----------------------------------------------------------------------------------------
Sub ユーザーが選択したファイル名を取得する_複数選択可能()
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "1つ以上のファイルを選択して [OK]をクリックしてください。"
        .AllowMultiSelect = True
        .Show
        For I = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(I)
        Next
    End With
End Sub
'=========================================================================================

＜コメント＞
※１ "C:\"にはフォルダパスを記入

7) ファイル名や拡張子を変更する

'=========================================================================================
Sub ファイル名や拡張子を変更する()
    ドライブ = "C"                              '※１
        ChDrive = ドライブ                      '指定ドライブへ切り替え
    パス = ドライブ & ":\" & "Suguni"           '※２
        ChDir = パス                            '指定フォルダへ切り替え
    旧ファイル名 = "YNxv.cvs"                   '※３
    新ファイル名 = "YNxv.txt"                   '※４
        Name 旧ファイル名 As 新ファイル名       '旧ファイル名を新ファイル名に変更する
End Sub
'-----------------------------------------------------------------------------------------
Sub ファイル名や拡張子を変更する_直接表現()
    Name "C:\Suguni\YNxv.csv" As "C:\Suguni\YNxv.txt" '※５
End Sub
'-----------------------------------------------------------------------------------------
Sub ファイル名や拡張子を変更して他のフォルダに移動する()
    Name "C:\Suguni\YNxv.csv" As "C:\Sagyo\YNxv.txt" '※６
End Sub
'=========================================================================================

＜コメント＞
※１ "C"にはドライブ番号を記入
※２ "Suguni"にはフォルダ名を記入
※３ "YNxv.cvs"には旧ファイル名を拡張子付きで記入
※４ "YNxv.txt"には新　　　〃　　　　　〃
※５ As の左側が旧、右側が新
※６フォルダ名も As の左側と右側で変えている

8) ファイルのサイズと更新日時を取得する

'=========================================================================================
Sub ファイルのサイズと更新日時を取得する()
    フルパス = "C:\BBB.xls"                     'フルパス(ファイル名付き)を指定する ※１
    更新日時 = FileDateTime(フルパス)           '更新日時を取得する
    サイズ = FileLen(フルパス)                  'ファイルのサイズを取得 ※２
End Sub
'-----------------------------------------------------------------------------------------
Sub アクティブブックの更新日時を取得する()
    更新日時 = ActiveWorkbook.BuiltinDocumentProperties("LAST SAVE TIME")
End Sub
'-----------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------
Sub 開いていないファイルの更新日時を取得する()
    フルパス = "C:\BBB.xls"
    更新日時 = CreateObject("scripting.FileSystemObject") _
                .GetFile(フルパス).DateLastModified
End Sub
'=========================================================================================

＜コメント＞
※１ドライブ名とフォルダ名は省略可能、txtファイル等も指定可能
※２指定したファイルが既に開いている場合は開かれる前のサイズが取得される

9) 個人情報の削除可否を設定する

'=========================================================================================
Sub 個人情報の削除可否を設定する()              '※１
    ActiveWorkbook.RemovePersonalInformation = True  '削除可能にする ※２
    ActiveWorkbook.RemovePersonalInformation = False '削除不可能にする
    MsgBox ActiveWorkbook.RemovePersonalInformation  '削除可否を取得する
End Sub
'=========================================================================================

＜コメント＞
※１ RemovePersonalInformationプロパティで制御される個人情報は作成者・管理者・会社名
　　　であり、マクロ記録した場合のユーザー名は対象外
※２ブックを保存したときに削除される

10) フォルダ名を取得する

'=========================================================================================
Sub フォルダ名を取得してワークシートに表示する()
    Worksheets("SSS").Activate                  '※１ ワークシートをアクティブにする
    Cells.Clear                                 'すべてのセルをクリアする
    パス = "C:\"                                '※２ パスを指定する
    Cells(1, 1).Value = "「" & パス & "」のフォルダ名" 'A1セルに見出しをセットする
    行 = 2                                      '行カウンタをセットする
    フォルダ = Dir(パス, vbDirectory)           '名前を取得する
'
    Do While フォルダ <> ""                     '取得した名前がヌルでなければ
        If フォルダ <> "." And フォルダ <> ".." Then '現在フォルダと親フォルダでなければ
            If (GetAttr(パス & フォルダ) And vbDirectory) = vbDirectory Then
                                                '取得した名前がフォルダなら
                Cells(行, 1).Value = フォルダ   '取得したフォルダ名を表示する
                行 = 行 + 1                     '行カウンタを上げる
            End If
        End If
        フォルダ = Dir                          'フォルダ名を取得する
    Loop                                        '繰り返す
'
    With Columns("A:A")
        .EntireColumn.AutoFit
        .HorizontalAlignment = xlLeft
    End With                                    'A列の幅を最適化して左詰めする
    Range("A1").Select
End Sub
'-----------------------------------------------------------------------------------------
Sub ユーザーが選択したフォルダ名を取得する()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択して [OK]をクリックしてください。"
        .InitialFileName = "C:\"
        .Show
        MsgBox .SelectedItems(1)
    End With
End Sub
'=========================================================================================

＜コメント＞
※１ SSSにはシート名を記入
※２ C:\にはパスを指定する

11) 終了処理

'=========================================================================================
Sub 終了処理()
    Application.DisplayAlerts = False           '1)閉じる際に確認メッセージを出さない
    Application.Quit                            '2)アプリケーション(エクセル)を終了する
End Sub
'=========================================================================================