Sample Macro  開始終了 [応用型] Previous Next

1) 最近使用したファイルリスト このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 最近使用したファイルリスト内のファイル数を取得して表示する()
    ファイル数 = Application.RecentFiles.Maximum
    MsgBox "最近使用したファイルリスト内のファイル数: " & ファイル数
End Sub
'---------------------------------------------------------------------------------
Sub 最近使用したファイルリスト内の1番目のファイルのファイル名を表示する()
    ファイル名 = Application.RecentFiles(1).Name    '※1
    MsgBox "最近使用したファイルリスト内の1番目のファイルのファイル名: " & ファイル名
End Sub
'---------------------------------------------------------------------------------
Sub 最近使用したファイルリスト内の1番目のファイルへの絶対パスを表示する()
    絶対パス = Application.RecentFiles(1).Path
    MsgBox "最近使用したファイルリスト内の1番目のファイルへの絶対パス: " & 絶対パス
End Sub
'---------------------------------------------------------------------------------
Sub 最近使用したファイルリストのファイル数を設定する()
    Application.RecentFiles.Maximum = 4
End Sub
'---------------------------------------------------------------------------------
Sub 最近使用したファイルリストに追加する()
    ファイル名 = "BBB.xls"                          '※2
    Application.RecentFiles.Add Name:=ファイル名
End Sub
'---------------------------------------------------------------------------------
Sub 最近使用したファイルリストの3番目のファイルを開く()
    Application.RecentFiles.Item(3).Open
End Sub
'---------------------------------------------------------------------------------
Sub 最近使用したファイルリストの内容をワークシートにセットする()
Dim ファイル数 As Long
Dim 行 As Long

    ファイル数 = Application.RecentFiles.Maximum '最近使用したファイルリスト内のファイル数
    Sheets.Add                              'ワークシートを挿入する

    For 行 = 1 To ファイル数
        Cells(行, 1) = 行
        Cells(行, 2) = Application.RecentFiles(行).Name 'ファイル名
        Cells(行, 3) = Application.RecentFiles(行).Path '絶対パス
    Next

    Columns("A:C").EntireColumn.AutoFit     '列幅を最適化する
    Range("A1").Select                      'カーソルを左上端へ
    メッセージ = "最近使用したファイルリストの内容を、ワークシートにセットしました"
    MsgBox メッセージ, vbInformation, "すぐマク"
    Application.DisplayAlerts = False       '確認メッセージを表示しない
    ActiveWindow.SelectedSheets.Delete      'ワークシートを削除する
    Application.DisplayAlerts = True        '確認メッセージを表示する
End Sub
'=================================================================================
<コメント>
※1 ファイルリストにパスを含んだファイル名が表示されている場合は、それが取得される
※2 ファイル名にはパスを含めることができる
※3 「最近使用したファイルリスト」とは[ファイル]メニューをクリックしたときに表示されるドロッ
   プダウンメニューの下部のリストのことである


2) コード実行中ブック以外のブックを閉じる このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub コード実行中のブック以外のブックを閉じる()
    For Each 要素 In Workbooks                  '各ワークブックに対して反復処理する
        If 要素.Name <> ThisWorkbook.Name Then  'コード実行中のブック名と違うなら
            要素.Close savechanges:=False       '保存しないで閉じる ※1
        End If
    Next                                        '繰り返す
End Sub
'=================================================================================
<コメント>
※1 ブックに変更があり、同じブックが他のウィンドウで表示されていないときに、Closeメソッドの
   引数 savechangesの値を省略するとファイル名の入力を促すダイアログボックスが表示され、
   Trueを指定すると保存される


3) フォルダーを開く このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダーを開く()
    絶対パス = ActiveWorkbook.Path              'パスを取得する
    MsgBox "OKボタンを押すとフォルダー内容が表示されますから、" & Chr(13) & _
            "開きたいファイルを選んでダブルクリックして下さい。"
    タスクID = Shell("explorer.exe " & 絶対パス, vbNormalFocus) 'フォルダーを開く '※1、2、3
    If タスクID = 0 Then MsgBox "起動に失敗しました"
End Sub
'=================================================================================
<コメント>
※1 プログラムの実行に問題が発生した場合、タスクIDには 0 が返る
※2 Shell関数の名前付き引数 windowstyleの詳細は こちら
※3 Maintoshでの指定方法は異なる


4) フォルダー名を取得してワークシートに表示する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub フォルダー名を取得してワークシートに表示する()
    Worksheets("SSS").Activate                  '※1 ワークシートをアクティブにする
    Cells.Clear                                 'すべてのセルをクリアする
    パス = "C:\"                                '※2 パスを指定する
    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
'=================================================================================
<コメント>
※1 SSSにはシート名を記入
※2 C:\にはパスを指定する


5) ドライブの一覧表を作成する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Option Explicit
Dim ファイルシステム As Object
Dim ドライブコレクション As Object
Dim メンバ As Object
Dim ドライブ文字 As String
Dim タイプ As String
Dim 装置名 As String
Dim 行 As Integer
'---------------------------------------------------------------------------------
Sub ドライブの一覧表を作成する()
    Worksheets("SSS").Activate                  '※1
        Cells.Select
        Selection.Clear
        Range("A1").Value = "ドライブ文字"
        Range("B1").Value = "ドライブタイプ"
        Range("C1").Value = "装置名"
        行 = 1
                                                'ファイルシステムへの参照を作成する
    Set ファイルシステム = CreateObject("Scripting.FileSystemObject")
    Set ドライブコレクション = ファイルシステム.Drives '利用できるDrivesコレクションを取得
    For Each メンバ In ドライブコレクション     'Drivesコレクションの各メンバに繰り返し処理
        ドライブ文字 = メンバ.DriveLetter       'ドライブ文字を取得する
        タイプ = メンバ.DriveType               'ドライブタイプを取得する
        ドライブタイプを装置名に変換する
        行 = 行 + 1
        Cells(行, 1) = ドライブ文字
        Cells(行, 2) = タイプ
        Cells(行, 3) = 装置名
    Next

    Columns("A:C").EntireColumn.AutoFit
    Range("A1").Select
End Sub
'---------------------------------------------------------------------------------
Private Sub ドライブタイプを装置名に変換する()
    Select Case タイプ
        Case 0
            装置名 = "不明"
        Case 1
            装置名 = "リムーバブルディスク"
        Case 2
            装置名 = "ハードディスク"
        Case 3
            装置名 = "ネットワークドライブ"
        Case 4
            装置名 = "CD-ROM"
        Case 5
            装置名 = "RAMディスク"
    End Select
End Sub
'=================================================================================
<コメント>
※1 SSSにはシート名を記入
サンプルブックのダウンロードは ここをクリック (YNxv251_FileSystem_Drives.xls 40KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


6) 光学ドライブを探して媒体挿入状況取得 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 光学ドライブを探して媒体挿入状況を取得する()
    With CreateObject("Scripting.FileSystemObject")
        For Each 各ドライブ In .Drives
            ドライブ種類 = 各ドライブ.DriveType '※1
            If ドライブ種類 = 4 Then
                If .GetDrive(各ドライブ).IsReady Then '※2
                    MsgBox "光学ドライブは" & 各ドライブ & "で、媒体が挿入されています。"
                Else
                    MsgBox "光学ドライブ(" & 各ドライブ & ")に媒体を挿入してください。"
                End If
            End If
        Next
    End With
End Sub
'=================================================================================
<コメント>
※1 0:不明、1:リムーバブルディスク、2:ハードディスク、3:ネットワークドライブ、
   4:光学ドライブ、5:RAMディスク
※2 True:ドライブの準備ができている、False:準備できていない


7) 環境変数の一覧表を作成する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 環境変数の一覧表を作成する()
    Cells.Clear
    Range("A1").Value = "順番"
    Range("B1").Value = "環境変数の名前と値"
    I = 1
    Do
        Range("A" & I + 1).Value = I
        Range("B" & I + 1).Value = Environ(I)   '環境変数の名前と値を取得
        I = I + 1
    Loop Until Environ(I) = ""                  '※1
    Columns("A:B").EntireColumn.AutoFit
End Sub
'=================================================================================
<コメント>
※1 指定した番号が存在しなければ長さ0の文字列("")が返る

Excel VBA Macro