【VBA】名前をつけて保存の処理について

先ほどの投稿の続きのコードとなります。
ブックAの内容を別ブックBの①シートに貼付後InputBoxで該当セルに入力していく処理となります。

最後に、名前をつけて保存の処理を行いたいのですが、名前を付けて保存のポップアップ画面は出てファイル名を入力後保存を押すと下記のエラーが出ます。

「オブジェクトが必要です」

VBAはネットで調べたコードを組み合わせているので原因が分かりません。
お助けいただけないでしょうか。

デバッグを行うと、Call wb.SaveAs(filePath) ' 名前を付けて保存
が黄色の塗りつぶしになっております。

Sub
1
2    Dim RC As Integer
3    Dim OpenFileName, fileName, Path, SetFile As String
4    Dim wbMoto, wbSaki As Workbook
5
6    Set wbMoto = ActiveWorkbook  'マスターデータ取り込み元をセット
7
8    Application.DisplayAlerts = False
9    
10    RC = MsgBox("マスターデータ取込みますか？", vbYesNo + vbQuestion, "確認")
11    
12    If RC = vbYes Then
13            
14            OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
15            'ダイアログボックスを表示して、マスターデータファイルを指定します。
16            
17            If OpenFileName <> "False" Then
18                 SetFile = OpenFileName
19            Else
20                MsgBox "キャンセルされました"
21                Exit Sub  'マスターデータの取り込みをキャンセル
22            End If
23    
24            
25            Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0
26            'ダイアログボックスで指定したマスターデータファイルを開きます。
27            
28            Set wbSaki = Workbooks.Open(Path & SetFile)
29            
30                'ワークブック間のシート「項目」をコピーします。
31                wbSaki.Worksheets("内訳書").Range("D:O").Copy
32                wbMoto.Worksheets("見積入力").Range("U7").PasteSpecial xlPasteValues
33                 
34                
35                Application.CutCopyMode = False  'コピー切り取りを解除
36                wbSaki.Close False  'マスターデータ取り込み先のファイルを閉じる
37  
38        Else
39        
40        MsgBox "処理を中断します"
41    
42    End If
43    
44    Application.DisplayAlerts = True
45    
46     Dim ans As String
47    ans = InputBox("見積書・請求書No", "", "")
48
49    If ans <> "" Then
50       wbMoto.Worksheets("見積(").Range("I3").Value = ans
51       Worksheets("見積").Range("I3").Value = "あいう-" & ans
52
53    End If
54    
55        Application.DisplayAlerts = True
56    
57     
58    ans = InputBox("見積書発行日", "", "")
59
60    If ans <> "" Then
61       wbMoto.Worksheets("見積").Range("F11").Value = ans
62    End If
63    
64    ans = InputBox("完工日", "", "")
65
66    If ans <> "" Then
67       wbMoto.Worksheets("請求").Range("F11").Value = ans
68    End If
69
70        ans = InputBox("請求書発行日", "", "")
71
72    If ans <> "" Then
73       wbMoto.Worksheets("請求").Range("F12").Value = ans
74    End If
75    
76    Dim filePath As String
77    filePath = Application.GetSaveAsFilename ' ダイアログを表示
78
79    If filePath = "False" Then
80    Exit Sub ' キャンセル
81    End If
82
83    ' 保存
84    Call wb.SaveAs(filePath) ' 名前を付けて保存
85    End Sub
86'
87'
88
89コード

行動規範の内容に同意します

回答1件

自己解決

調べていたところ、開いているブックの名前を名前を付けて保存する際のダイアログボックスに表示して保存できる方法を見つけました。

自分の備忘録も兼ねて記載しておきます。

Dim
1    xFile = Application.GetSaveAsFilename( _
2    FileFilter:="Excelファイル, *.xlsm")
3    If TypeName(xFile) <> "Boolean" Then
4    ActiveWorkbook.SaveAs FileName:=xFile
5    End If
6    
7コード

投稿2021/08/24 04:18

sh444

総合スコア15