プロが教えるわが家の防犯対策術!

マクロ有効形式で保存されるタイミングで指定シートの指定セル値を削除できる方法を教えてください。
マクロ
Sub 電子提出()
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(Array("記載方法")).Delete
Worksheets(Array("提出図書(参考)")).Delete
Worksheets(Array("消防の指摘一覧(参考資料)")).Delete
Worksheets(Array("Web申請手順(参考)")).Delete
Worksheets(Array("申請種別")).Delete
Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled
Worksheets("提出シート").Activate
Range("B1", "H47").Select
myBook = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook
Application.Quit
With ThisWorkbook
.Saved = True
Application.DisplayAlerts = True
.Close False
End With
Sheets("提出シート").Shapes("新築FD").Visible = False '
Sheets("提出シート").Shapes("計変FD").Visible = False '
Sheets("提出シート").Shapes("増築FD").Visible = False '
Sheets("提出シート").Shapes("担当者").Visible = False '
End Sub
があります。
マクロを実行すると、不要シートを削除し、指定セル値がファイル名になり
マクロ有効形式「.xlsm」と一般の「.xlsx」の2つのファイルで保存されます。
マクロ有効形式「.xlsm」で保存されるタイミングで
指定シート名「提出シート」のセル「D3」「D4」「D7」の文字等の表示を削除できる方法を教えてください。
一般の「.xlsx」は現状のままでお願いいたします。
よろしくお願いいたします。

質問者からの補足コメント

  • うーん・・・

    回答ありがとうございます。
    教えてください、
    今回教えて頂けたコードは私のマクロコードとは別にマクロを作成して
    例えば
    Sub 電子2()
    Application.Run "Macro1"(貴者のマクロ)
    Application.Run " 電子提出"
    End Sub
    とするのでしょうか。このマクロを実行しても指定セル値が削除できませんでした。
    貴者のコードを私のマクロコードのどの部分に追加したら良いかの方法を教えてください。
    よろしくお願いいたします。

    No.1の回答に寄せられた補足コメントです。 補足日時:2023/03/02 09:03
  • 回答ありがとうございます。
    私の希望通りに上手くできましたが、
    マクロを実行するとマクロ有効ブックの保存先のダイナログ
    が開き、保存すると、もう一度同じダイナログが開き
    上書き保存のダイナログが表示されてしまいます。
    2回目のダイナログを非表示に出来る方法があれば教えてください。

    No.2の回答に寄せられた補足コメントです。 補足日時:2023/03/02 13:36
  • もう一つお願いがあります。
    Range("B1", "H47").Select
    ですが
    ファイル形式「.xlsx」のファイルのみ有効にしたいのですが
    現状はマクロ有効「.xlsm」でもRange("B1", "H47").Selectでの範囲指定がされております。
    Range("B1", "H47").Selectの範囲指定は「.xlsx」ファイルを開き
    Ctrl+Cを押して範囲指定をコピーするためのコードですので
    「.xlsx」のファイルのみに必要なコードで
    マクロ有効「.xlsm」では不要です。
    何度も申し訳ありません。
    以上の解決方法をお願い致します。

      補足日時:2023/03/02 13:37
  • ありがとうございます。
    Range("B1", "H47").Select
    は解決いたしましたが
    やはり、保存用のダイナログが2回開いてしまします。
    申し訳ありません、解決方法を教えてください。
    念のため、何回かに分けてコードをお送りいたします。
    Sub 電子提出()
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets(Array("記載方法")).Delete
    Worksheets(Array("提出図書(参考)")).Delete
    Worksheets(Array("消防の指摘一覧(参考資料)")).Delete
    Worksheets(Array("Web申請手順(参考)")).Delete
    Worksheets(Array("申請種別")).Delete

    No.3の回答に寄せられた補足コメントです。 補足日時:2023/03/02 14:06
  • Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled
    Worksheets("提出シート").Activate
    Worksheets("提出シート").Activate
    Dim rng As Range
    Set rng = Selection.Cells
    Range("B1", "H47").Select
    myBook = ThisWorkbook.Path
    ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook
    rng.Select

      補足日時:2023/03/02 14:07
  • Sheets("提出シート").Range("D3,D4,D7").ClearContents
    Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled

    Application.Quit
    With ThisWorkbook
    .Saved = True
    Application.DisplayAlerts = True
    .Close False
    End With

      補足日時:2023/03/02 14:07

A 回答 (4件)

補足のコード・・上の


Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled
Worksheets("提出シート").Activate
これダブっていますよね 不要です
消し忘れ?
    • good
    • 0
この回答へのお礼

何度もありがとうございました。
私のミスでした。
全て上手くできました。
いつも、助けて頂きまして
ありがとうございます。

お礼日時:2023/03/02 15:42

VBA実行時の選択範囲をRange変数に取得して実行(選択)後


範囲選択を戻す事で処理できると思います

Worksheets("提出シート").Activate
Dim rng As Range
Set rng = Selection.Cells
Range("B1", "H47").Select
myBook = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook
rng.Select
Sheets("提出シート").Range("D3,D4,D7").ClearContents
Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled
この回答への補足あり
    • good
    • 0

こんにちは


>マクロ有効形式「.xlsm」で保存されるタイミングで
>指定シート名「提出シート」のセル「D3」「D4」「D7」の文字等の表示を削除できる方法を教えてください。
>一般の「.xlsx」は現状のままでお願いいたします。

現状.xlsmが先に出力されていますので順番を入れ替えて処理する必要があると思います
>Range("B1", "H47").Select
の目的は不明ですが・・・

該当部分コードです


Worksheets(Array("申請種別")).Delete
Worksheets("提出シート").Activate
Range("B1", "H47").Select
myBook = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook

Sheets("提出シート").Range("D3,D4,D7").ClearContents
Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled

Application.Quit

この回答への補足あり
    • good
    • 0

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


If SaveAsUI = True And Right(Me.FullName, 4) = "xlsm" Then 'マクロ有効形式で保存される場合
With Sheets("提出シート")
.Range("D3").ClearContents
.Range("D4").ClearContents
.Range("D7").ClearContents
End With
End If
End Sub
このコードは、マクロ有効形式で保存される前に自動的に実行されます。保存前のファイル名の拡張子が「xlsm」である場合に、指定のシート「提出シート」の指定セル「D3」「D4」「D7」の内容を削除します。一般の「.xlsx」で保存する場合には、このイベントは実行されません。
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!