エクセルでセル値をファイル名にして保存しようと思っています。

エクセルでセル値をファイル名にして保存しようと思っています。

エクセル2003では以下の方法でセル値を取得して保存しています。
'Cell値を取得
strName2 = Sheets("#######").Range("A1").Value
strName3 = Sheets("*******").Range("B2").Value
'strName2の値が空の場合、現在のブック名を代入
If strName2 = "" Then strName = ThisWorkbook.Name
'セル値の結合
sName = strName3 + strName2
'名前を付けて保存] ダイアログ ボックスを表示
fName = Application.GetSaveAsFilename(InitialFileName:=sName, fileFilter:="Excel(*.xls), *.xls")
'ファイル名を取得したら保存
If fName <> False Then ActiveWorkbook.SaveAs fName

同様の操作を2007以降で「マクロを有効にして保存」を行いたいのですが、どの様にすればいいのでしょうか？

（自動保存では以下の様になる状態の事です。）
ActiveWorkbook.SaveAs Filename:="#:\*******.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

2007の時の「'名前を付けて保存] ダイアログ ボックスを表示」の方法が分かりません。

共通の命令文では出来でしょうから、最終的にはエクセルのバージョンを取得して、IFで分岐させようと思っています。
宜しくお願い致します。

No.1 ベストアンサー 回答者： end-u 回答日時： 2010/10/22 21:12

fName = Application.GetSaveAsFilename(InitialFileName:=sName, fileFilter:="Excel(*.xlsm), *.xlsm")

です。

また、キャンセル時の対応についてですが、
変数fNameを　Dim fName As Variant　あるいは　Dim fName
と、Variant型で宣言してるなら、

If VarType(fName) <> vbBoolean Then
　　ActiveWorkbook.SaveAs Filename:=fName, _
　　　　　　　　　　　　　FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If

こんな感じでVarType関数を使ってチェックしたほうが良いと思います。

この回答へのお礼

同じコードを試して上手く行かなかったので質問させていただいたのですが、ツインPCで操作していて2003で試してしまっていたみたいです。
ポカミスでした。ありがとうございます。

お礼日時：2010/10/27 09:54

No.2 回答者： goo793ww 回答日時： 2010/10/23 04:48

※Excelのセルには適当な次のデータ一覧が有るとします。

C8:C～ フォルダ(フルパス)… D:\Test\
D8:D～ 現行ファイル名 … xxxlog009.txt
G8:G～ 新規ファイル名 … zzzlog009.txt

▼リネームのソースコードは、こんな感じかな（実機確認済み）
Sub Rename()
Dim LastRow As Long
Dim R As Long
Dim rtn As Integer
LastRow = Range("G65536").End(xlUp).Row '←新規ファイル名の列の最終行を取得する
On Error GoTo Err_FileRename
For R = 8 To LastRow
If Cells(R, 7).Value <> "" Then
Range(Cells(R, 7), Cells(R, 7)).Font.ColorIndex = 5 '←文字を青色にする
Name Cells(R, 3) & Cells(R, 4) As Cells(R, 3) & Cells(R, 7)
End If
Next R
Exit Sub
Err_FileRename:
Range(Cells(R, 7), Cells(R, 7)).Font.ColorIndex = 3 '←文字を赤色にする
Resume Next
End Sub

この回答へのお礼

ありがとうございます。
かなり汎用性が高そうです。
今後の参考にさせて頂きます。

お礼日時：2010/10/27 09:55