こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2017-01-28 01:45:00

QNo.9286720

すぐに回答ほしいです

質問者が選んだベストアンサー

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」とすればいいだけです。

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

投稿日時 - 2017-01-28 09:01:16

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

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

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



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 "保存されませんでした"


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

投稿日時 - 2017-01-28 09:59:25

お礼

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

投稿日時 - 2017-01-28 14:22:46

あなたにオススメの質問