Excelマクロでファイル名を任意指定したい

質問

下記のVBAでアクティブにしたいファイル名を任意に指定したり、新しく作成したシート名を任意に指定出来るようにしたいと思っています。ご助言を頂ければ幸いです。

Sub 名別_M()

' 名別_M Macro
'
Cells.Select
Selection.Delete Shift:=xlUp

' MsgBox "挿入する「ファイル」を選択してください"

On Error Resume Next
With CreateObject("WScript.Shell")
.currentdirectory = ThisWorkbook.Path
End With
On Error GoTo 0

Workbooks.Open "C:\Users\user\Desktop\Excel\自己練習\Sample2.xlsx" '←パスとファイル名を分けてファイル名を任意で指定したい。

Workbooks("Sample2.xlsx").Activate '←上記で任意に指定したファイル名を入れたい。

Range("A1").Select
On Error Resume Next
Application.DisplayAlerts = False
Sheets("名別").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Dim NewSheetName As String
NewSheetName = InputBox("元データのあるシート名を入力ください")
If NewSheetName = "" Then Exit Sub

'下記ではシート名を「名別」で固定しているが、これも任意に指定したい。

Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"シート1!R1C1:R95C18", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet1!R3C1", TableName:="ピボットテーブル2", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "名別"
Cells(3, 1).Select
With ActiveSheet.PivotTables("ピボットテーブル2").PivotFields("UserName")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("ピボットテーブル2").AddDataField ActiveSheet.PivotTables( _
"ピボットテーブル2").PivotFields("作業時間"), "合計 / 作業時間", xlSum
ActiveSheet.PivotTables("ピボットテーブル2").CompactLayoutRowHeader = "UserName"
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Range("C16").Select

MsgBox "上書き保存します"
On Error Resume Next
ActiveWorkbook.Save
If Err.Number > 0 Then MsgBox "保存されませんでした"
End Sub

回答No.1

Prome_Lin · ベストアンサー

Workbooks.Open "C:\Users\user\Desktop\Excel\自己練習\Sample2.xlsx"

の上に「fn = "～"」としておいて、

Workbooks.Open "C:\Users\user\Desktop\Excel\自己練習\fn

とするだけです。

Workbooks("Sample2.xlsx").Activate

も同じく「Workbooks(fn).Activate」とするだけですが、

もし、「fn」に「Sample2」しか入力しないのでしたら、もちろん、「fn = "" & ".xlsx"」としておかなければなりません。

「fn」は、「fn = InputBox("FileName ? ")」によって入力することも可能ですね。

Sheets("Sheet1").Name = "名別"

も、単に「sn = "～"」としておいて、「Sheets("Sheet1").Name = sn」とすればいいだけです。

お勉強、がんばってください。

回答No.2

tsubu-yuki

以前の質問でどなたかが
「変数にワークブックを代入する」
という回答を下さっていたと思いますが、それは理解できましたか？
そこを理解できていればそんなに難しい案件でもなさそうな気がしますよ。

さて。
せっかくですから、ご自身でも
「ファイルを開くダイアログ ＶＢＡ」辺りで検索してみましょう。
まぁ、処理自体も謎が多いのですが・・・

Dim myBook As WorkBook, myFile As String
Dim NewSheet As String
Dim mySH As Worksheet

　　　　' シートの中身を全部消す（？）
　　　　Cells.delete

　　　　’ ファイルを指定し、「名前」を変数に代入するダイアログ
　　　　myFile = Application.GetOpenFilename( _
　　　　　　　　Title:="ファイルを選択", _
　　　　　　　　MultiSelect:=False, _
　　　　　　　　filefilter:="エクセルファイル,*.xls*")
　　　　' キャンセルされたらマクロ中止
　　　　If myFile = "False" Then
　　　　　　　　MsgBox "キャンセル"
　　　　　　　　Exit Sub
　　　　End If

　　　　' 代入された名前のファイルを開き、変数に代入
　　　　Set myBook = Workbooks.Open(Filename:=myFile)

　　　　' シート名を指定
　　　　NewSheet = InputBox("元データのあるシート名を入力ください")
　　　　　　　　' 中断する可能性もあり（？）
　　　　　　　　If NewSheet = "" Then Exit Sub

　　　　' 同じ名前のワークシートがあったら削除
　　　　i = 0
　　　　For Each mySH In ActiveWorkbook.Sheets
　　　　　　　　If mySH.Name = NewSheet Then mySH.Delete
　　　　　　　　i = 1
　　　　Next

　　　　If i = 0 then
　　　　　　　　If MsgBox("該当シートがありません" & VbNewLine & _
　　　　　　　　　　　　　　　　"処理を続行しますか", vbYesNo) = vbNo Then
　　　　　　　　　　　　MsgBox ”中断しました"
　　　　　　　　End If
　　　　End If

　　　　' 新規ワークシートを作成、変数に代入
　　　　Set mySH = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　　　　　　mySH.Name = NewSheet

　　　　' ピボットテーブルの元データはどこにあるのかしら？
　　　　Set myRange = Worksheets("Sheet1").Range("A1").CurrentRegion

　　　　ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
　　　　　　　　　　　　SourceData:=myRange, _
　　　　　　　　　　　　Version:=xlPivotTableVersion14).CreatePivotTable _
　　　　　　　　　　　　TableDestination:=mySh.Range("A1"), _
　　　　　　　　　　　　TableName:="myPivot", _
　　　　　　　　　　　　DefaultVersion:=xlPivotTableVersion14

　　　　With ActiveSheet.PivotTables("myPivot")
　　　　　　　　With .PivotFields("name")
　　　　　　　　　　　　.Orientation = xlRowField
　　　　　　　　　　　　.Position = 1
　　　　　　　　End With
　　　　　　　　.AddDataField .PivotFields("作業時間"), "合計 / 作業時間", xlSum
　　　　　　　　.CompactLayoutRowHeader = "UserName"
　　　　End With

　　　　'
　　　　MsgBox "上書き保存します"
　　　　On Error Resume Next
　　　　ActiveWorkbook.Save
　　　　If Err.Number > 0 Then MsgBox "保存されませんでした"

サンプルデータがないので、検証はしていません。
色々お試しくださいませ。

お礼

有難うございました。色々勉強になりました。与えて頂いたコードを元に再度勉強しなおします。