マクロを実行時に「名前を付けて保存」のダイナログが開き「保存(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.3ベストアンサー
- 回答日時:
ごめんなさい なぜこのようなロジックになっているのか・・・
変では無いかな?? テ
ンプレみたいに使いたいのかな・・まあいいです・・
コードについて 各ブックを明示するのはどうですか・・・
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
回答ありがとうございました。
全て上手く行きました。
何度も何度も、色々と質問させていたことが
この度の回答で全て解決いたしました。
感謝いたします。
No.2
- 回答日時:
単純に「名前を付けて保存」のダイナログを使わなければ良いのでは?
途中抜粋
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
- 回答日時:
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/17 11:59
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/20 16:59
- PowerPoint(パワーポイント) エクセルのマクロについて教えてください。 1 2022/03/25 17:03
- Excel(エクセル) エクセルのマクロについて教えてください。 2 2023/02/20 14:46
- Excel(エクセル) エクセルのマクロについて教えてください。 2 2023/02/21 13:29
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/02/21 11:19
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Access(アクセス) ExcelのVBAコードについて教えてください。 4 2023/01/20 09:44
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
2つのマクロでチェックボックス...
-
Excel・Word リサーチ機能を無...
-
Excel マクロ VBA プロシー...
-
一つのTeratermのマクロで複数...
-
特定文字のある行の前に空白行...
-
特定のPCだけ動作しないVBAマク...
-
メッセージボックスのOKボタ...
-
VBAでカタカナ→ローマ字の変換...
-
エクセルで別のセルにあるふり...
-
エクセルに張り付けた写真のフ...
-
Excelでボタン(フォームコント...
-
TERA TERMを隠す方法
-
エクセルで特定の列が0表示の場...
-
マクロ実行時、ユーザーフォー...
-
VC++ 2008 EXPRESS "_T"識別子...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
ExcelVBA 図形をクリックした...
-
EXCELのVBAでRange("A1:C4")を...
-
Excelのマクロについて教えてく...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel・Word リサーチ機能を無...
-
特定のPCだけ動作しないVBAマク...
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
メッセージボックスのOKボタ...
-
一つのTeratermのマクロで複数...
-
ExcelのVBA。public変数の値が...
-
エクセルに張り付けた写真のフ...
-
他人が作ったマクロの理解
-
ExcelVBAでPDFを閉じるソース
-
TERA TERMを隠す方法
-
エクセルで別のセルにあるふり...
-
マクロ実行時、ユーザーフォー...
-
Excel VBAからAccessマクロを実...
-
EXCELのVBAでRange("A1:C4")を...
-
TeraTermマクロの文字列結合
-
PDF出力マクロについて。マクロ...
-
#defineの定数を文字列として読...
-
エクセルのマクロをセルの値に...
-
wordを起動した際に特定のペー...
おすすめ情報
回答ありがとうございます。
ご指示の通りにコードを設定しましたが、別添の画像のようにエラー表示が出てしまします。
解決方法をお願いいたします。
回答ありがとうございます。
ご指示の通りのコードを設定でダイナログを非表示で指定フォルダ先に保存は出来ましたが
変更前のマクロだと
ダイナログで保存をクリックした後、作業中のブックが開いたままの状態で、次の作業に移行できたのですが、
今回のマクロでは新しいファイルの保存後、作業中のブックがクローズしてしまい、一般のExcel画面になってしまいます。
変更前のように、新しいファイルを保存後、作業ブックは開いたままの状態にすることが可能でしょうか。
新しく保存されたファイル名と作業ブックのファイル名とは違うファイル名です。
作業ブックのファイル名は作業ブックのシート名「青紙表」セル値「CE1」がファイル名になります。
回答をお待ちしております。よろしくお願いいたします。