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


1) 開始処理 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 開始処理()
    Application.ScreenUpdating = False          '0)画面を更新しない
    ChDrive "C"                                 '1)指定ドライブへ切り替え ※1
    ChDir "\" & "FFF"                           '1)指定フォルダーへ切り替え ※2
    Workbooks.Open FILENAME:="BBB" & ".xls"     '1)指定されたブックを開く ※3
    Sheets("SSS").Select                        '2)指定されたシートを選択 ※4
    Range("A1").Select                          '3)初期セルを選択する ※5
End Sub
'=================================================================================
<コメント>
※1 Cにはフォルダーが格納されているドライブを記入
※2 FFFにはブックが格納されているフォルダー名を記入
※3 BBBには開きたいブック名を記入、Openメソッドの引数は こちら
※4 SSSには開きたいシート名を記入
※5 A1にはあるセルを選択すると画面が一番整然と映るというセルを指定する。
   ウインドウ枠が固定されたシートの場合は、非固定部分内の左上セルになる。


2) 操作環境 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Public Function 操作環境についての情報()
    Range("C3").Formula = "=INFO(""release"")"  'INFO関数をセルにセットする ※2、3
    操作環境についての情報 = Range("C3").Value  '操作環境についての情報を取り出す ※2
End Function
'---------------------------------------------------------------------------------
Sub 操作環境についての情報を取得する()
    ワークシート関数式 = "=INFO(""release"")"   '※3
    MsgBox Evaluate(ワークシート関数式)
End Sub
'=================================================================================
<コメント>
※1 Visual Basicから呼び出せないワークシート関数は、セルにセットして使います
※2 C3には関数をセットするセル名を記入
※3 "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) 環境変数の値を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 環境変数の値を取得する()
    名前 = "PATH"                               '環境変数の名前を指定 ※1
    MsgBox Environ(名前)                        '環境変数の値を取得できる
    番号 = 12                                   '環境変数の番号を指定 ※2
    MsgBox Environ(番号)                        '環境変数の名前と値を取得できる
End Sub
'=================================================================================
<コメント>
※1、2 環境変数の番号・名前・値 … こちら


4) プロセッサの情報を取得 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub プロセッサの情報を取得する()
    Set システム = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                            InstancesOf("Win32_Processor")
    For Each 各要素 In システム
        With 各要素
            MsgBox "プロセッサ:   " & .Name
        End With
    Next
    Set システム = Nothing
End Sub
'=================================================================================
<コメント>
※1 [コントロール パネル]-[システムとセキュリティ]-[システム]に表示される値を取得できる
   コントロールパネルの一部


5) ドライブの有無とドライブ名を取得 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ドライブの有無を調べる()
    ドライブ = "D"                              '※4
    With CreateObject("Scripting.FileSystemObject")
        If .DriveExists(ドライブ) Then
            MsgBox ドライブ & "ドライブは有ります。"
        Else
            MsgBox ドライブ & "ドライブは有りません。"
        End If
    End With
End Sub
'=================================================================================
Sub アクティブブックが格納されているドライブ名を取得する()
    ドライブ名 = CreateObject("scripting.FileSystemObject") _
                .GetFile(ActiveWorkbook.FullName).Drive
End Sub
'=================================================================================
<コメント>
※1 Dには調査したいドライブを記入


6) フォルダー名を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダー名を取得する()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダーを選択して [OK]をクリックしてください。"
        .InitialFileName = "C:\"                '※1
        If .Show = True Then
            フォルダー名 = .SelectedItems(1)
            MsgBox フォルダー名 & " が選択されました。", , "すぐマク"
        Else
            MsgBox "[キャンセル]ボタンがクリックされました。", , "すぐマク"
        End If
    End With
End Sub
'---------------------------------------------------------------------------------
Sub フォルダー名を取得する_BrowseForFolderメソッド()
    With CreateObject("Shell.Application")
        Set フォルダー = .BrowseForFolder(&O0, "フォルダーを選んでください", &H1 + &H10, "C:\")
        If フォルダー Is Nothing Then
            MsgBox "[キャンセル]ボタンがクリックされました。", , "すぐマク"
        Else
            MsgBox フォルダー.Items.Item.Path
        End If
    End With
    Set フォルダー = Nothing
End Sub
'=================================================================================
Sub フォルダー中の全てのサブフォルダーの名前を取得する()
    フォルダーパス = "C:\A\"                      '※3
    With CreateObject("Scripting.FileSystemObject")
        For Each 各サブフォルダー In .GetFolder(フォルダーパス).SubFolders
            MsgBox 各サブフォルダー.Name
        Next
    End With
End Sub
'=================================================================================
<コメント>
※1 C:\ にはパスを指定する
※2 BrowseForFolderメソッドの引数は、Hwnd, sTitle, iOptions, vRootFolder
   Hwnd … 親ウィンドウのハンドル (ゼロでよい)
   sTitle … ダイアログボックスのタイトル
   iOptions … メソッドのためのオプションを含む整数値
   vRootFolder … 初期表示フォルダー (省略すると[デスクトップ]になるが、ユーザーはそれを
             選択することはできない)
※3 C:\A\ にはフォルダーパスを指定する


7) フォルダーの有無を調べる このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダーの有無を調べる_Dir関数にて()
    フォルダーパス = "C:\A"                      '※1
    If Dir(フォルダーパス, vbDirectory) <> "" Then '※2
        MsgBox フォルダーパス & " フォルダーは存在します。", , "すぐマク"
    Else
        MsgBox フォルダーパス & " フォルダーは存在しません。", , "すぐマク"
    End If
End Sub
'=================================================================================
Sub フォルダーの有無を調べる_FileSystemObjectにて()
    フォルダーパス = "C:\A"                      '※1
    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(フォルダーパス) Then
            MsgBox "そのフォルダーは存在します。", , "すぐマク"
        Else
            MsgBox "そのフォルダーは存在しません。", , "すぐマク"
        End If
    End With
End Sub
'=================================================================================
<コメント>
※1 C:\ にはパスを指定する (ドライブ指定に誤りがないこと)
※2 Dir関数の第2(attributes)引数に vbDirectory を指定する


8) フォルダーを作成する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダーを作成する()
    親フォルダーパス = "C:\"                    '※1
    新フォルダー名 = "AA"                       '※2
    フォルダーパス = 親フォルダーパス & 新フォルダー名
    On Error Resume Next
    MkDir フォルダーパス
    If Err <> 0 Then
        MsgBox フォルダーパス & " … 既存です。", , "すぐマク"
    End If
End Sub
'---------------------------------------------------------------------------------
Sub フォルダーを作成する_FileSystemObject()
    親フォルダーパス = "C:\"                    '※1
    新フォルダー名 = "AA"                       '※2
    フォルダーパス = 親フォルダーパス & 新フォルダー名
    On Error Resume Next
    CreateObject("Scripting.FileSystemObject").CreateFolder フォルダーパス
    If Err <> 0 Then
        MsgBox フォルダーパス & " … 既存です。", , "すぐマク"
    End If
End Sub
'---------------------------------------------------------------------------------
Sub フォルダーが存在しなければ作成する()
    フォルダーパス = "C:\A"                      '※3
    On Error Resume Next
    CreateObject("Scripting.FileSystemObject").CreateFolder フォルダーパス
End Sub
'=================================================================================
<コメント>
※1 新フォルダーを作成するための親フォルダーのパスを記入する
※2 新しく作成するフォルダーの名前を記入する
※3 C:\ にはパスを指定する(ドライブ指定に誤りがないこと)


9) フォルダーをコピーする このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダーをコピーする()
    コピー元フォルダー = "C:\A"                 '※1
    新しいフォルダー = "C:\A2"                  '※2
    CreateObject("Scripting.FileSystemObject") _
        .CopyFolder コピー元フォルダー, 新しいフォルダー
End Sub
'=================================================================================
Sub フォルダーのコピーを名前を変えて作成する()
    コピー元フォルダー = "C:\A\A2"              '※1
    新しいフォルダー = "C:\A\A3"                  '※2
    CreateObject("Scripting.FileSystemObject") _
        .CopyFolder コピー元フォルダー, 新しいフォルダー
End Sub
'=================================================================================
<コメント>
※1 コピー元フォルダーの絶対パスを記入する
※2 コピーしてできる新しいフォルダーの絶対パスを記入する
※3 サブフォルダーおよびフォルダー中のファイルを含めてコピーされる


10) フォルダーを削除する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダーを削除する()
    削除するフォルダー = "C:\A\A3"                '※1
    CreateObject("Scripting.FileSystemObject") _
        .DeleteFolder 削除するフォルダー, force:=True '※2
End Sub
'=================================================================================
<コメント>
※1 削除するフォルダーの絶対パスを記入する
※2 force引数にTrueを設定しないと、削除したいフォルダーの中に読み取り専用ファイルがあると
   [実行時エラー '70": 書き込みできません。]になる


11) ファイル名を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub アクティブブックのファイル名を取得する()
    ファイル名 = ActiveWorkbook.Name
End Sub
'---------------------------------------------------------------------------------
Sub アクティブブックのファイル名を取得する_FileSystemObjectの場合()
    ファイル名 = CreateObject("scripting.FileSystemObject") _
                .GetFile(ActiveWorkbook.FullName).Name
End Sub
'=================================================================================
Sub ユーザーが選択したファイル名を取得する()
    初期表示パス = "C:\"                        '※1
    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
'=================================================================================
Sub フォルダー中の全てのファイルの名前を取得する()
    フォルダーパス = "C:\A\"                      '※1
    With CreateObject("Scripting.FileSystemObject")
        For Each 各ファイル In .GetFolder(フォルダーパス).Files
            MsgBox 各ファイル.Name
        Next
    End With
End Sub
'=================================================================================
<コメント>
※1 "C:\" または C:\A\ にはフォルダーパスを記入


12) ファイル名や拡張子を変更する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ファイル名や拡張子を変更する()
    ドライブ = "C"                              '※1
        ChDrive = ドライブ                      '指定ドライブへ切り替え
    パス = ドライブ & ":\" & "Suguni"           '※2
        ChDir = パス                            '指定フォルダーへ切り替え
    旧ファイル名 = "YNxv.cvs"                   '※3
    新ファイル名 = "YNxv.txt"                   '※4
        Name 旧ファイル名 As 新ファイル名       '旧ファイル名を新ファイル名に変更する
End Sub
'---------------------------------------------------------------------------------
Sub ファイル名や拡張子を変更する_直接表現()
    Name "C:\Suguni\YNxv.csv" As "C:\Suguni\YNxv.txt" '※5
End Sub
'---------------------------------------------------------------------------------
Sub ファイル名や拡張子を変更して他のフォルダーに移動する()
    Name "C:\Suguni\YNxv.csv" As "C:\Sagyo\YNxv.txt" '※6
End Sub
'=================================================================================
<コメント>
※1 "C"にはドライブ番号を記入
※2 "Suguni"にはフォルダー名を記入
※3 "YNxv.cvs"には旧ファイル名を拡張子付きで記入
※4 "YNxv.txt"には新   〃     〃
※5 As の左側が旧、右側が新
※6 フォルダー名も As の左側と右側で変えている


13) ファイルの有無を調べる このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ファイルの有無を調べる()
    ファイル名 = "BBB.xls"                      '※1
    フォルダーパス = "C:\FFF"                     '※2
    フルパス = フォルダーパス & "\" & ファイル名
    If Dir(フルパス) = "" Then
        MsgBox フォルダーパス & " には " & ファイル名 & " は存在しません。"
    Else
        MsgBox フォルダーパス & " に " & ファイル名 & " が存在します。"
    End If
End Sub
'=================================================================================
<コメント>
※1 BBB.xlsにはファイル名(拡張子付き)を記入
※2 フォルダーパスを記入


14) ファイルのサイズを取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ファイルのサイズを取得する()
    フルパス = "C:\BBB.xls"                     'フルパス(ファイル名付き)を指定する ※1
    サイズ = FileLen(フルパス)                  'ファイルのサイズを取得 ※2
End Sub
'=================================================================================
<コメント>
※1 ドライブ名とフォルダー名は省略可能、txtファイル等も指定可能
※2 指定したファイルが既に開いている場合は開かれる前のサイズが取得される


15) ファイルの更新日時などを取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ファイルの更新日時を取得する()
    フルパス = "C:\BBB.xls"                     'フルパス(ファイル名付き)を指定する ※1
    更新日時 = FileDateTime(フルパス)           '更新日時を取得する
End Sub
'---------------------------------------------------------------------------------
Sub アクティブブックの更新日時を取得する()
    更新日時 = ActiveWorkbook.BuiltinDocumentProperties("LAST SAVE TIME")
End Sub
'---------------------------------------------------------------------------------
使用可能なExcelのバージョン
'---------------------------------------------------------------------------------
Sub 開いていないファイルの更新日時などを取得する()
    フルパス = "C:\BBB.xls"
    更新日時 = CreateObject("scripting.FileSystemObject") _
                .GetFile(フルパス).DateLastModified
    作成日時 = CreateObject("scripting.FileSystemObject") _
                .GetFile(フルパス).DateCreated
    最終アクセス日時 = CreateObject("scripting.FileSystemObject") _
                .GetFile(フルパス).DateLastAccessed
End Sub
'=================================================================================
<コメント>
※1 ドライブ名とフォルダー名は省略可能、txtファイル等も指定可能
※2 指定したファイルが既に開いている場合は開かれる前のサイズが取得される


16) パスを取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub パスを取得する()
    パス = ActiveWorkbook.Path                'アクティブウィンドウのブックのパス ※1、2
    パス = ThisWorkbook.Path                  '実行中のマクロが記述されているブックのパス
    パス = Application.Path                   '現在のアプリ(Excel)へのパス ※1
    パス = Application.DefaultFilePath        '起動時のカレントフォルダー ※1
    パス = Application.StartupPath            '起動(XLStart)フォルダー) ※1
    パス = Application.LibraryPath            'アドイン(Library)フォルダー ※1
    パス = CurDir                             '指定ドライブの現在のパス ※1
End Sub
'---------------------------------------------------------------------------------
Sub フルパスを取得する()
    フルパス = ActiveWorkbook.FullName          'フルパス(パス付ブック名)
End Sub
'---------------------------------------------------------------------------------
Sub パスセパレータを取得する()
    パスセパレータ = Application.PathSeparator  '現在システムで使用中のパスセパレータ
End Sub
'---------------------------------------------------------------------------------
使用可能なExcelのバージョン
'---------------------------------------------------------------------------------
Sub パスを取得する()
    パス = Environ("windir")                    'Windowsフォルダー ※1、3
    パス = Environ("temp")                      'Tempフォルダー ※1、3
End Sub
'---------------------------------------------------------------------------------
Sub デスクトップのパスを取得する()
    パス = CreateObject("WScript.Shell").SpecialFolders("desktop") '※1、5
End Sub
'---------------------------------------------------------------------------------
Sub MyDocumentsのパスを取得する()
    パス = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") '※1、5
End Sub
'---------------------------------------------------------------------------------
使用可能なExcelのバージョン
'---------------------------------------------------------------------------------
Sub パスを取得する()
    絶対パス = Application.UserLibraryPath      '自作のアドイン(Addins)フォルダー ※4
End Sub
'=================================================================================
<コメント>
※1 パス末尾の円記号 (\) とファイル名を含まない絶対パス
※2 ActiveWorkbook の代わりに Workbooks(1)のように書いても良い
※3 Environ関数の構文: Environ({envstring | number })
   envstring は環境変数の名前、 number は環境文字列テーブル内の順番、共に省略可
※4 パス末尾の円記号 (\) が含まれない場合がある
※5 WSHのSpecialFoldersプロパティの引数
フォルダー 引数 備考
全ユーザーに共通のデスクトップ AllUsersDesktop Windows XP 以上
全ユーザーに共通のプログラムメニュー AllUsersPrograms    〃
全ユーザーに共通のスタートメニュー AllUsersStartMenu    〃
全ユーザーに共通のスタートアップ AllUsersStartup    〃
ログインユーザーのデスクトップ Desktop  
ログインユーザーのプログラムメニュー Programs  
ログインユーザーのスタートメニュー StartMenu  
ログインユーザーのスタートアップ Startup  
アプリケーションデータ AppData  
お気に入り Favorites  
フォント Fonts  
マイドキュメント MyDocuments  
マイネットワーク NetHood  
プリンターとFAX PrintHood  
最近使ったファイル Recent  
送る SendTo  
テンプレート Templates  


17) 個人情報の削除可否を設定する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 個人情報の削除可否を設定する()              '※1
    ActiveWorkbook.RemovePersonalInformation = True  '削除可能にする ※2
    ActiveWorkbook.RemovePersonalInformation = False '削除不可能にする
    MsgBox ActiveWorkbook.RemovePersonalInformation  '削除可否を取得する
End Sub
'=================================================================================
<コメント>
※1 RemovePersonalInformationプロパティで制御される個人情報は作成者・管理者・会社名
   であり、マクロ記録した場合のユーザー名は対象外
※2 ブックを保存したときに削除される


18) エラー対策 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 予期せぬエラーへの対策()
    On Error GoTo エラー処理                    '※1 エラーが発生した時の飛び先
    試し = Dir("A:\無い名前.xls")               '※2 わざとエラーを発生させるための例示
    Exit Sub                                    '※3 正常終了
エラー処理:                                     '※3 エラーが発生した時の入り口
    MsgBox "作業を中止します。原因を取り除いてから、やり直してください。", _
    vbCritical, "予期せぬエラーが発生しました ... " & Str(Err) & ": " & Error(Err)
    Application.DisplayAlerts = False           '※3 閉じる際に確認メッセージを出さない
    Close                                       '※3 ファイルをすべて閉じる
    Application.Quit                            '※3 エクセルを終了する
End Sub
'=================================================================================
<コメント>
※1 本来の処理の先頭に記述する
※2 ここで本来の処理を記述する
※3 本来の処理の末尾に記述する
※4 エラー番号の一例
番号 メッセージ 番号 メッセージ 番号 メッセージ
7 メモリが足りません 11 0で除算しました 13 型が一致しません
18 ユーザー割り込みが発生しました 53 ファイルが見つかりません 57 デバイスI/O(入出力)エラーです
68 デバイスが準備されていません 70 書き込みできません 71 ディスクが準備されていません


19) 終了処理 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 終了処理()
    Application.DisplayAlerts = False           '1)閉じる際に確認メッセージを出さない
    Application.Quit                            '2)アプリケーション(エクセル)を終了する
End Sub
'=================================================================================

Excel VBA Macro