EXCEL2000でのVBAについて

質問

お世話になります。

EXCEL2000のVBで下記のことをしたいのですが、うまく出来ないところがあり対処方法を教えて頂きたいです。

(1)アクティブブックの名前を取得

(2)ブックのセルA1の値を取得

(3)保存ダイアログでA1の値をファイル名にし保存

(4)保存したファイルを閉じる

(5)基のアクティブブックを再度開く

以上です。

今できていないのは(1)と(5)です。

基のアクティブブックの名前をプログラム上に直接入力する分には出来るのですが、
ファイル名が変更になった時に、いちいちVBを書き換えるのが面倒なだけです…

コードを提示しますので、ご教授願えればと思います。

Sub 保存()

Dim ファイル名 As String, フォルダ名 As Object, フォルダ選択 As Object, ファイル名2 As Workbook

Set ファイル名2 = ActiveWorkbook

ファイル名 = Range("A1").Value
Set フォルダ選択 = CreateObject("Shell.Application")
Set フォルダ名 = フォルダ選択.BrowseForFolder(0, "保存フォルダを選んでください", 1)
ActiveWorkbook.SaveAs Filename:=フォルダ名.items.Item.Path & "\" & ファイル名 & ".xls"
MsgBox ファイル名 & ".xls", vbOKOnly, フォルダ名 & "に保存しました"

Workbooks.Open "C:\test\" & ファイル名2

Workbooks(ファイル名 & ".xls").Close

End sub

ファイル名の取得が間違っていると思うのですが、ネットなどで調べてみましたが、よくわかりませんでした。

回答No.1

end-u · ベストアンサー

>Workbooks.Open "C:\test\" & ファイル名2
ファイル名2　は Workbookオブジェクトです。
Openメソッドでは ファイル名2.Name などのように名前を指定しなければいけませんが、
「ファイル名2」は既に別名で保存された新しいファイルなので、
元のBook名は保持してません。

最低限の修正では以下ですが
Sub 保存2()
　　Dim ファイル名　 As String
　　Dim フォルダ名　 As Object
　　Dim フォルダ選択 As Object
　　Dim ファイル名2　As Workbook
　　Dim s As String '●

　　Set ファイル名2 = ActiveWorkbook
　　s = ファイル名2.FullName '●
　　ファイル名 = Range("A1").Value
　　Set フォルダ選択 = CreateObject("Shell.Application")
　　Set フォルダ名 = フォルダ選択.BrowseForFolder(0, "保存フォルダを選んでください", 1)
　　ファイル名2.SaveAs Filename:=フォルダ名.self.Path & "\" & ファイル名 & ".xls"
　　MsgBox ファイル名 & ".xls", vbOKOnly, フォルダ名 & "に保存しました"
　　Workbooks.Open s '●
　　ファイル名2.Close

　　Set ファイル名2 = Nothing
　　Set フォルダ名 = Nothing
　　Set フォルダ選択 = Nothing
End Sub

新Bookを閉じて元Bookを開き直すのであれば、最初からSaveCopyAsメソッドを使えば良いかと思います。
Sub test()
　　Dim f As Object

　　Set f = CreateObject("Shell.Application").BrowseForFolder(0, "保存フォルダを選んでください", 1)
　　If f Is Nothing Then Exit Sub
　　ActiveWorkbook.SaveCopyAs f.self.Path & "\" & Range("A1").Value & ".xls"
　　Set f = Nothing
End Sub

お礼

ご回答ありがとうございます。

上のコード参考にさせて頂き、うまく動きました。

ファイル名の取得も何となく理解？出来た様な気がします。

ありがとうございました。