| |
|
|
Sample Macro ブックシート [応用型] |
 |
|
|
|
1) フォルダ中のファイル名をシートに書く |
 |
 |
'=========================================================================================
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) テキストファイルを行単位で読み込む |
|
|
'=========================================================================================
Option Explicit
Dim バッファ As Variant '読み込み用バッファ
Dim 行 As Long '貼り付け用の行カウンタ
'-----------------------------------------------------------------------------------------
Sub テキストファイルを行単位で読み込む() '※１
Worksheets("SSS").Activate 'ワークシートをアクティブにする ※２
Columns("A:A").Clear 'A列をすべてクリアする ※３
ファイル名 = "TTT.txt" 'ファイル名を指定する ※４
Open ファイル名 For Input As #1 '指定のファイルを開く
行 = 0 '行カウンタをゼロにする
Do Until EOF(1) 'フアイルが終りでなければ繰り返す
Line Input #1, バッファ '行全体を読み込んで変数に代入する
行 = 行 + 1 '行カウンタの値に 1加える
Cells(行, 1) = バッファ '読み込んだ文字列をセルにセットする ※４
Loop '繰り返す
Close #1 'ファイルを閉じる
End Sub
'=========================================================================================
＜コメント＞
※１ スペースも有効に読み込む。詳細は テキストファイルをスペースも有効に読み込みたいが 参照
※２ SSSにはシート名を記入
※３ A:Aには読み込んだデータをセットする列名を、(行, 1)の1には同じく列番号を記入
※４ TTTにはテキストファイルのファイル名を記入
※５ カンマ区切りのテキストファイルの場合は 受信データ自動編集 を参照
|
3) ブックのプロパティをシートにセットする |
|
 |
'=========================================================================================
Sub アクティブブックのプロパティをワークシートにセットする()
Worksheets("SSS").Activate '※１
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
'=========================================================================================
＜コメント＞
※１ SSSにはシート名を記入
|
4) サーバーのブックを利用状況に合わせて開く |
|
|
'=========================================================================================
Sub サーバーのブックを他のユーザーがすでに開いていたら開かない()
With Workbooks.Open("E:\A\DB.xls") '※１、２
If .ReadOnly Then .Close False '読み取り専用で開いた場合は閉じる
End With
End Sub
'=========================================================================================
Sub サーバーのブックを開く_NotifyTrue型()
With Workbooks.Open("E:\A\DB.xls", Notify:=True) '※１、２
If .ReadOnly Then '読み取り専用で開いたなら ※３
引数NotifyがTrueか省略の場合の説明文を表示する
Else 'そうでないなら
MsgBox "読み取り／書き込みモードで開きました"
End If
End With
End Sub
'-----------------------------------------------------------------------------------------
Sub サーバーのブックを開く_Notify省略型()
With Workbooks.Open("E:\A\DB.xls") '※１、２
If .ReadOnly Then '※３
引数NotifyがTrueか省略の場合の説明文を表示する
Else
MsgBox "読み取り／書き込みモードで開きました"
End If
End With
End Sub
'-----------------------------------------------------------------------------------------
Sub サーバーのブックを開く_NotifyFalse型()
With Workbooks.Open("E:\A\DB.xls", Notify:=False) '※１、２、４
If .ReadOnly Then '※３
引数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
'=========================================================================================
＜コメント＞
※１ この例は サーバーを[ネットワークドライブの割り当て]でEドライブとして設定している前提、
サーバーを直接指定する場合は 「\\コンピュータ名\フォルダ名\ファイル名」のように記述する
(コンピュータ名 ： [スタートメニュー]クリック、[コンピュータ]右クリック、[プロパティ]クリック)
※２ Openメソッドの引数 Notifyに Falseを設定すると、他のユーザーが使用中の場合に、
読み取り専用で開くかどうかを問い合わせるダイアログボックスが表示され、
True または省略すると表示されない
※３ この場合、他のユーザーがブックを閉じると ファイル使用可能ダイアログ が表示される
※４ 読み取り専用で開くかどうかを問い合わせるダイアログボックスのキャンセルボタンがクリック
されたときに実行されるマクロコードが必要、無いと実行時エラー（Openメソッド失敗）になる
|
5) ファイルダイアログを表示してブックを開く |
|
 |
'=========================================================================================
Private Sub ファイルダイアログを表示してブックを開く()
タイトル = "ブックを選択してから、[開く]ボタンをクリックしてください。"
ファイルの場所 = "C:\フォルダA\フォルダB" 'ファイルの場所（フォルダパスで指定）
フィルタ1a = "Excel ブック" 'ファイルの種類（分かりやすく）
フィルタ1b = "*.xls" ' 〃 （拡張子）
With Application.FileDialog(msoFileDialogOpen) '[ファイルを開く]ダイアログについて
.Title = タイトル
.InitialFileName = ファイルの場所 '※１
.Filters.Clear 'フィルタをクリア
.Filters.Add フィルタ1a, フィルタ1b 'フィルタを設定
.AllowMultiSelect = False '複数選択不可
.Show '表示する
If .SelectedItems.Count > 0 Then '選択されたアイテム数が1以上なら
.Execute 'ファイルを開く
Else
MsgBox "[キャンセル]または[×]ボタンがクリックされました。", , "すぐマク"
End If
End With
End Sub
'=========================================================================================
＜コメント＞
※１ 指定したフォルダが存在しないとファイル名と解釈される場合がある
|
6) マクロブックでない方のファイル名を取得する |
|
|
'=========================================================================================
Sub マクロブックでない方のファイル名を取得する()
Dim オブジェクト As Workbook
For Each オブジェクト In Workbooks
If オブジェクト.Name <> ThisWorkbook.Name Then
MsgBox オブジェクト.Name
End If
Next
End Sub
'=========================================================================================
＜コメント＞
※１ マクロブックと他のファイルが開いている状態で実行する
|
7) 複数シートの同じ位置へ列を挿入する |
|
|
'=========================================================================================
Sub 複数シートの同じ位置へ列を挿入する()
シートA = "Sheet1" '※１
シートB = "Sheet2" '※１
シートC = "Sheet3" '※１
列 = 2 '※２
Worksheets(Array(シートA, シートB, シートC)).Select '※３
Columns(列).Select
Selection.Insert Shift:=xlToRight '列を挿入する ※４
End Sub
'=========================================================================================
＜コメント＞
※１ "Sheet1"、"Sheet2"、"Sheet3" のようにシート名を必要に応じて指定する
※２ 列を挿入したい位置の列名を指定する
※３ Array関数の ( ) の中の引数は必要に応じて指定する
※４ 列の挿入以外の操作に置換してもよい
|
8) ワークシートを追加してそのシート名を変更する |
|
|
'=========================================================================================
Sub ワークシートを追加してそのシート名を変更する()
Worksheets("SSS").Activate '※１
Worksheets.Add '※２ ワークシートを追加する
ActiveSheet.Name = "新しい名前" '※３ シート名を変更する
End Sub
'=========================================================================================
＜コメント＞
※１ SSSにはシート名を記入
※２ アクティブシートの前へ追加される（後へ追加したい場合はAfter引数を指定する）
※３ ""内に新しい名前を指定する
|
9) ブックが開いているか調べる |
|
|
'=========================================================================================
Sub ブックが開いているか調べる()
ブック名 = "BBB.xls" '※１
For Each 各ブック In Workbooks
If 各ブック.Name = ブック名 Then
MsgBox "開いています。", , ブック名
Exit Sub
End If
Next
MsgBox "開いていません。", , ブック名
End Sub
'=========================================================================================
＜コメント＞
※１ BBBにはブック名を記入
|
