Sample Macro  ブックシート [応用型] Previous Next

1) フォルダー中のファイル名をシートに書く このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Option Explicit
Dim ドライブ As String                          'フォルダーが存在するドライブ
Dim フォルダー As String                        'フォルダー名
Dim 拡張子 As String                            'ファイルタイプ(拡張子)
Dim 記入シート As String                        'ファイル名を記入するシート名
Dim パス As String                              'パス
Dim ファイル名 As String                        'ファイル名の取り出しエリア
Dim 貼付行 As Integer                           '貼付行ポインタ
'---------------------------------------------------------------------------------
Sub フォルダー中のファイル名をシートに書く()
    ドライブ = "C"                             'ドライブを指定する
    フォルダー = "受信"                         'フォルダー名を指定する
    拡張子 = "*." & "txt"                       '拡張子を指定する(この例はtxtまたはTXT)
    記入シート = "ファイル一覧"                 'ファイル名の記入用シートを指定する
    指定フォルダー中の指定拡張子のファイル名をシートに書く
End Sub
'---------------------------------------------------------------------------------
Private Sub 指定フォルダー中の指定拡張子のファイル名をシートに書く()
    Sheets(記入シート).Activate                 'ファイル名を記入用シートをアクティブにする
        Cells.Clear                             'すべてクリア
        Range("A1").Select
    パス = ドライブ & ":\" & フォルダー & "\"   'パスを組む
    ファイル名 = Dir(パス & 拡張子)             '指定された拡張子のファイル名を取り出す
    貼付行 = 0                                  '貼付行ポインタを初期化する

    Do While ファイル名 <> ""                   '取り出したファイル名がヌルでなければ
        貼付行 = 貼付行 + 1                     '貼付行ポインタを上げる
        Cells(貼付行, 1).Value = ファイル名     'セルにファイル名を記入する
        ファイル名 = Dir()                      '次のファイル名を取り出す
    Loop                                        '繰り返し処理
End Sub
'=================================================================================


2) ファイルの情報を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 開きたいファイルの場所とファイル名を取得する()
    タイトル = "開きたいファイルの場所と、ファイル名を選択してください" '※1
    ボタン = "決 定"                                                '※2
入力:
    パス = Application.GetOpenFilename(Title:=タイトル, buttontext:=ボタン) 'ダイアログ表示
    If パス <> False Then
        MsgBox パス, vbInformation, "開きたいファイルの場所と、ファイル名"
    Else
        MsgBox "不正な選択です、やり直してください", vbExclamation, タイトル
        GoTo 入力
    End If
End Sub
'---------------------------------------------------------------------------------
Sub ファイルの種類を指定してファイルを開くダイアログを表示する() '※3
    ファイル名 = Application.GetOpenFilename(FileFilter:="CSV_File (*.csv), *.csv")
End Sub
'=================================================================================
Sub ファイルを保存する場所とファイル名を取得する()
    タイトル = "ファイルを保存する場所とファイル名を、選択または入力してください" '※1
    ボタン = "決 定"                                                          '※4
入力:
    パス = Application.GetSaveAsFilename(Title:=タイトル, buttontext:=ボタン) '※5
    If パス <> False Then
        MsgBox パス, vbInformation, "ファイルを保存する場所と、ファイル名"
    Else
        MsgBox "不正な選択です、やり直してください", vbExclamation, タイトル
        GoTo 入力
    End If
End Sub
'=================================================================================
<コメント>
※1 ダイアログボックスのタイトル、Windows版だけに有効
※2 ダイアログボックスの「開く」ボタンの文字、Macintosh版だけに有効
※3 ダイアログボックスで選択されたファイルは実際には開かれない
※4 ダイアログボックスの「保存」ボタンの文字、Macintosh版だけに有効
※5 これ以外の引数 InitialFilename:ファイル名の初期値、
   FileFilter:ファイルの種類のフィルタ(例 "Excelファイル,*.xls;*.xlt,CSVファイル,*.csv")、
   FilterIndex:初期表示するフィルタの番号(例 前例の場合に2を指定すればCSVとなる)
サンプルブックのダウンロードは ここをクリック (YNxv202_information.xls 72KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


3) ブックのプロパティをシートにセットする このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub アクティブブックのプロパティをワークシートにセットする()
    Worksheets("SSS").Activate                  '※1
        Cells.Clear
        行 = 1
        For Each プロパティ In ActiveWorkbook.BuiltinDocumentProperties
            Cells(行, 2).Value = プロパティ.Name 'プロパティ名
            On Error GoTo 値が設定されていない
            Cells(行, 3).Value = プロパティ.Value 'プロパティの値
            Cells(行, 1).Value = 行             'コレクションのインデックス値
            行 = 行 + 1
        Next
        Columns("A:C").EntireColumn.AutoFit
        Range("A1").Select
        Exit Sub

値が設定されていない:
            Resume Next
End Sub
'=================================================================================
<コメント>
※1 SSSにはシート名を記入


4) サーバーのブックを利用状況に合わせて開く このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub サーバーのブックを他のユーザーがすでに開いていたら開かない()
    With Workbooks.Open("E:\A\DB.xls")          '※1、2
        If .ReadOnly Then .Close False          '読み取り専用で開いた場合は閉じる
    End With
End Sub
'=================================================================================
Sub サーバーのブックを開く_NotifyTrue型()
    With Workbooks.Open("E:\A\DB.xls", Notify:=True) '※1、2
        If .ReadOnly Then                       '読み取り専用で開いたなら ※3
            引数NotifyがTrueか省略の場合の説明文を表示する
        Else                                    'そうでないなら
            MsgBox "読み取り/書き込みモードで開きました"
        End If
    End With
End Sub
'---------------------------------------------------------------------------------
Sub サーバーのブックを開く_Notify省略型()
    With Workbooks.Open("E:\A\DB.xls")          '※1、2
        If .ReadOnly Then                       '※3
            引数NotifyがTrueか省略の場合の説明文を表示する
        Else
            MsgBox "読み取り/書き込みモードで開きました"
        End If
    End With
End Sub
'---------------------------------------------------------------------------------
Sub サーバーのブックを開く_NotifyFalse型()
    With Workbooks.Open("E:\A\DB.xls", Notify:=False) '※1、2、4
        If .ReadOnly Then                       '※3
            引数NotifyがFalseの場合の説明文を表示する
        Else
            MsgBox "読み取り/書き込みモードで開きました"
        End If
    End With
End Sub
'---------------------------------------------------------------------------------
Private Sub 引数NotifyがTrueか省略の場合の説明文を表示する()
    MsgBox "【引数 Notify が True か 省略 で、他のユーザーがすでに開いている場合の動き】" _
            & Chr(13) & Chr(13) & _
            "1. 読み取り専用で開くかどうかの問い合わせはない" & Chr(13) & _
            "2. 開き終わるとタイトルバーに、[読み取り専用] と表示する"
End Sub
'---------------------------------------------------------------------------------
Private Sub 引数NotifyがFalseの場合の説明文を表示する()
    MsgBox "【引数 Notify が Falseで、他のユーザーがすでに開いている場合の動き】" _
            & Chr(13) & Chr(13) & _
            "1. 読み取り専用で開くかどうか、問い合わせする" & Chr(13) & _
            "2. 開き終わるとタイトルバーに、[読み取り専用] と表示する"
End Sub
'=================================================================================
<コメント>
※1 この例は サーバーを[ネットワークドライブの割り当て]でEドライブとして設定している前提、
   サーバーを直接指定する場合は 「\\コンピュータ名\フォルダー名\ファイル名」のように記述する
   (コンピュータ名 : [スタートメニュー]クリック、[コンピュータ]右クリック、[プロパティ]クリック)
※2 Openメソッドの引数 Notifyに Falseを設定すると、他のユーザーが使用中の場合に、
   読み取り専用で開くかどうかを問い合わせるダイアログボックスが表示され、
   True または省略すると表示されない
※3 この場合、他のユーザーがブックを閉じると ファイル使用可能ダイアログ が表示される
※4 読み取り専用で開くかどうかを問い合わせるダイアログボックスのキャンセルボタンがクリック
   されたときに実行されるマクロコードが必要、無いと実行時エラー(Openメソッド失敗)になる


5) ファイルダイアログを表示してブックを開く このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Private Sub ファイルダイアログを表示してブックを開く()
    タイトル = "ブックを選択してから、[開く]ボタンをクリックしてください。"
    ファイルの場所 = "C:\フォルダーA\フォルダーB\"   'ファイルの場所(フォルダーパスで指定)
    フィルタ1a = "Excel ブック"                       'ファイルの種類(分かりやすく)
    フィルタ1b = "*.xls"                             '   〃   (拡張子)
    With Application.FileDialog(msoFileDialogOpen)  '[ファイルを開く]ダイアログについて
        .Title = タイトル
        .InitialFileName = ファイルの場所             '※1
        .Filters.Clear                              'フィルタをクリア
        .Filters.Add フィルタ1a, フィルタ1b           'フィルタを設定
        .AllowMultiSelect = False                   '複数選択不可
        .Show                                       '表示する
        If .SelectedItems.Count > 0 Then            '選択されたアイテム数が1以上なら
            .Execute                                'ファイルを開く
        Else
            MsgBox "[キャンセル]または[×]ボタンがクリックされました。", , "すぐマク"
        End If
    End With
End Sub
'=================================================================================
<コメント>
※1 指定したフォルダーが存在しないとファイル名と解釈される場合がある


6) マクロブックでない方のファイル名を取得する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub マクロブックでない方のファイル名を取得する()
Dim オブジェクト As Workbook
    For Each オブジェクト In Workbooks
        If オブジェクト.Name <> ThisWorkbook.Name Then
            MsgBox オブジェクト.Name
        End If
    Next
End Sub
'=================================================================================
<コメント>
※1 マクロブックと他のファイルが開いている状態で実行する



7) 複数シートの同じ位置へ列を挿入する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 複数シートの同じ位置へ列を挿入する()
    シートA = "Sheet1"                          '※1
    シートB = "Sheet2"                          '※1
    シートC = "Sheet3"                          '※1
    列 = 2                                      '※2
    Worksheets(Array(シートA, シートB, シートC)).Select '※3
    Columns(列).Select
    Selection.Insert Shift:=xlToRight           '列を挿入する ※4
End Sub
'=================================================================================
<コメント>
※1 "Sheet1"、"Sheet2"、"Sheet3" のようにシート名を必要に応じて指定する
※2 列を挿入したい位置の列名を指定する
※3 Array関数の ( ) の中の引数は必要に応じて指定する
※4 列の挿入以外の操作に置換してもよい


8) ワークシートを追加してそのシート名を変更する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ワークシートを追加してそのシート名を変更する()
    Worksheets("SSS").Activate                  '※1
    Worksheets.Add                              '※2 ワークシートを追加する
    ActiveSheet.Name = "新しい名前"               '※3 シート名を変更する
End Sub
'=================================================================================
<コメント>
※1 SSSにはシート名を記入
※2 アクティブシートの前へ追加される(後へ追加したい場合はAfter引数を指定する)
※3 ""内に新しい名前を指定する

9) ブックが開いているか調べる このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ブックが開いているか調べる()
    ブック名 = "BBB.xls"                        '※1
    For Each 各ブック In Workbooks
        If 各ブック.Name = ブック名 Then
            MsgBox "開いています。", , ブック名
            Exit Sub
        End If
    Next
    MsgBox "開いていません。", , ブック名
End Sub
'=================================================================================
<コメント>
※1 BBBにはブック名を記入



10) テキストファイル行単位で読み込む このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Option Explicit
Dim バッファ As Variant                          '読み込み用バッファ
Dim 行 As Long                                  '貼り付け用の行カウンタ
'---------------------------------------------------------------------------------
Sub テキストファイルを行単位で読み込む()              '※1
    Worksheets("SSS").Activate                  'ワークシートをアクティブにする ※2
    Columns("A:A").Clear                        'A列をすべてクリアする ※3
    ファイル名 = "TTT.txt"                       'ファイル名を指定する ※4
    Open ファイル名 For Input As #1              '指定のファイルを開く
    行 = 0                                      '行カウンタをゼロにする
    Do Until EOF(1)                             'フアイルが終りでなければ繰り返す
        Line Input #1, バッファ                  '行全体を読み込んで変数に代入する
        行 = 行 + 1                             '行カウンタの値に 1加える
        Cells(行, 1) = バッファ                  '読み込んだ文字列をセルにセットする ※4
    Loop                                        '繰り返す
    Close #1                                    'ファイルを閉じる
End Sub
'=================================================================================
<コメント>
※1 スペースも有効に読み込む。詳細は テキストファイルをスペースも有効に読み込みたいが 参照
※2 SSSにはシート名を記入
※3 A:Aには読み込んだデータをセットする列名を、(行, 1)の1には同じく列番号を記入
※4 TTTにはテキストファイルのファイル名を記入
※5 カンマ区切りのテキストファイルの場合は 受信データ自動編集 を参照

Excel VBA Macro