エクセルのマクロについて教えてください。

マクロを実行時に「名前を付けて保存」のダイナログが開き「保存（S）」をクリックしてファイルを保存しておりますが、
マクロコードを利用してダイナログが開いたタイミングで「保存（S）」を自動でクリックできる方法があれば教えてください。
保存フォルダ先とファイル名がマクロで設定出来ている為、クリックを押す手間を省きたいのが目的です。
下記のマクロを変更出来ればしたいです。
Sub 行政報告2()
Application.ScreenUpdating = False
Dim folder As String
folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\" & Worksheets("300").Range("A41").Text & "　【担当】確認番号　建物名称\" & Worksheets("300").Range("A43").Text & "\"
Dim initName As String
initName = folder & Worksheets("1").Range("X1").Value
newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm")
If newName = False Then Exit Sub
ThisWorkbook.SaveCopyAs newName
Workbooks.Open newName
Dim ws As Worksheet
Dim TargetCheck As String
Dim List As Variant
Dim i As Long
Dim Chk As Boolean
List = Array("休日", "受付", "管理表")
For Each ws In Worksheets
Chk = False
If ws.Visible = False Then
For i = 0 To UBound(List)
If ws.Name = List(i) Then
Chk = True
Exit For
End If
Next i
If Chk = False Then
TargetCheck = TargetCheck & ws.Name & vbCrLf
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next ws
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
よろしくお願いいたします。

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

• 回答ありがとうございます。
  ご指示の通りにコードを設定しましたが、別添の画像のようにエラー表示が出てしまします。
  解決方法をお願いいたします。

  
  No.1の回答に寄せられた補足コメントです。 補足日時：2023/02/22 11:11

• 

  回答ありがとうございます。
  ご指示の通りのコードを設定でダイナログを非表示で指定フォルダ先に保存は出来ましたが
  変更前のマクロだと
  ダイナログで保存をクリックした後、作業中のブックが開いたままの状態で、次の作業に移行できたのですが、
  今回のマクロでは新しいファイルの保存後、作業中のブックがクローズしてしまい、一般のExcel画面になってしまいます。
  変更前のように、新しいファイルを保存後、作業ブックは開いたままの状態にすることが可能でしょうか。
  新しく保存されたファイル名と作業ブックのファイル名とは違うファイル名です。
  作業ブックのファイル名は作業ブックのシート名「青紙表」セル値「CE1」がファイル名になります。
  回答をお待ちしております。よろしくお願いいたします。

  
  No.2の回答に寄せられた補足コメントです。 補足日時：2023/02/22 12:01

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2023/02/22 12:36

ごめんなさい　なぜこのようなロジックになっているのか・・・

変では無いかな？？　テ
ンプレみたいに使いたいのかな・・まあいいです・・

コードについて　各ブックを明示するのはどうですか・・・
Sub 行政報告2()
Application.ScreenUpdating = False
Dim folder As String
folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\" & Worksheets("300").Range("A41").Text & "　【担当】確認番号　建物名称\" & Worksheets("300").Range("A43").Text & "\"
Dim initName As String
initName = folder & Worksheets("1").Range("X1").Value
newName = initName & ".xlsm"
Dim thisBk As Workbook
Dim copyBk As Workbook
Set thisBk = ActiveWorkbook
ThisWorkbook.SaveCopyAs newName
Set copyBk = Workbooks.Open(newName)
Dim ws As Worksheet
Dim TargetCheck As String
Dim List As Variant
Dim i As Long
Dim Chk As Boolean
List = Array("休日", "受付", "管理表")
For Each ws In copyBk.Worksheets
Chk = False
If ws.Visible = False Then
For i = 0 To UBound(List)
If ws.Name = List(i) Then
Chk = True
Exit For
End If
Next i
If Chk = False Then
TargetCheck = TargetCheck & ws.Name & vbCrLf
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next ws
copyBk.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub

この回答へのお礼

回答ありがとうございました。
全て上手く行きました。
何度も何度も、色々と質問させていたことが
この度の回答で全て解決いたしました。
感謝いたします。

お礼日時：2023/02/22 13:52

No.2 回答者： Qchan1962 回答日時： 2023/02/22 11:26

単純に「名前を付けて保存」のダイナログを使わなければ良いのでは？

途中抜粋
folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\" & Worksheets("300").Range("A41").Text & "　【担当】確認番号　建物名称\" & Worksheets("300").Range("A43").Text & "\"
Dim initName As String
initName = folder & Worksheets("1").Range("X1").Value
'不要---
'newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm")
'If newName = False Then Exit Sub
'---不要
newName = initName & ".xlsm"　'パス作成
ThisWorkbook.SaveCopyAs newName

No.1 回答者： 河内のおやじ 回答日時： 2023/02/22 09:57

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10

Sub 行政報告2()
Application.ScreenUpdating = False
Dim folder As String
folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\" & Worksheets("300").Range("A41").Text & "　【担当】確認番号　建物名称\" & Worksheets("300").Range("A43").Text & "\"
Dim initName As String
initName = folder & Worksheets("1").Range("X1").Value
newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm")
If newName = False Then Exit Sub
ThisWorkbook.SaveCopyAs newName
Workbooks.Open newName

' ダイアログが表示されているかどうかを確認する
Dim hwndDialog As Long
hwndDialog = FindWindow("#32770", "名前を付けて保存")

If hwndDialog <> 0 Then
' ダイアログ内の「保存」ボタンを検索する
Dim hwndButton As Long
hwndButton = FindWindowEx(hwndDialog, 0, "Button", "保存(&S)")

If hwndButton <> 0 Then
' ボタンをクリックする
SendMessage hwndButton, &HF5, 0, ByVal 0&
SendMessage hwndButton, WM_CLOSE, 0, ByVal 0&
End If
End If

Dim ws As Worksheet
Dim TargetCheck As String
Dim List As Variant
Dim i As Long
Dim Chk As Boolean
List = Array("休日", "受付", "管理表")
For Each ws In Worksheets
Chk = False
If ws.Visible = False Then
For i = 0 To UBound(List)
If ws.Name = List(i) Then
Chk = True
Exit For
End If
Next i
If Chk = False Then
TargetCheck = TargetCheck & ws.Name & vbCrLf
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next ws
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub