別の人から２回、同じこと質問されたから記事にしてみる。
１．お悩み
システムから生成されて起動したExcelを名前付けて保存したいけど、
Excel操作のライブラリはファイル名指定になってて新規ブックの保存ができません。
なるほど、確かにそーだね。
２．方法① エミュレーションしちゃいなよ。
前回は、この方法でアドバイスした。
そのウィンドウ、エミュレーションで「Ctrl + S」しちゃいなヨ。
新規ブックは、ウィンドウタイトルの数字がBook1とかBook2とか、変わったりするからウィンドウ識別ルールでタイトルの部分の指定を編集するといいですよ。って。
３．方法② スクリプト書いてみたよ。
これは、Excelでだけ使えるスクリプトだけどね。
エミュレーションで「Ctrl + S」だと、名前を付けて保存ダイアログ自分で操作しなきゃいけないしね。
18_Excel関連 - 新しいブックに名前を付けて保存
title_pattern = !新しいブック(正規表現)!
SavePath = !保存ファイル名!
opt = !保存後の処理|閉じる,そのまま!
Set fso = CreateObject("Scripting.FileSystemObject")
Set reg = CreateObject("VBScript.RegExp")
With reg
.Pattern = title_pattern
.IgnoreCase = False
.Global = True
End With
' workbookオブジェクトを取得する
Set workbook = Nothing
On Error Resume Next
' 既存のエクセルが起動されていれば警告を抑制する
Set existingXlsApp = Nothing
Set existingXlsApp = GetObject(, "Excel.Application")
For Each bk In existingXlsApp.Workbooks
If reg.Test(bk.Name) Then
Set workbook = bk
Exit For
End If
Next
On Error Goto 0
If workbook Is Nothing Then
' ブックは開かれていなかった
Err.Raise 1, "", "新しいブックが見つかりませんでした。"
WScript.quit
End If
' ====ハイライトを表示する========================================================
' HwndプロパティはExcel2002以降のみ対応
On Error Resume Next
ShowUMSHighlight(existingXlsApp.Hwnd)
On Error Goto 0
' ====ブックを閉じる==============================================================
On Error Resume Next
' 保存確認を出さないようにしてブックを閉じる
xlsApp.DisplayAlerts = False
filePath = fso.GetAbsolutePathName(SavePath)
workbook.SaveAs(filePath)
If opt = "閉じる" Then workbook.Close
xlsApp.DisplayAlerts = True
On Error Goto 0
If existingXlsApp.Workbooks.Count = 0 Then
existingXlsApp.Quit
End If
Set existingXlsApp = Nothing
Set workbook = Nothing
Set fso = Nothing
Set reg = Nothing
Set filePath = Nothing
備考
新規ブックのウィンドウをタイトルから探して名前を付けて保存します。
ブックタイトルのパターンは正規表現で指定します。例) Book1.xlsx で起動する場合は、「Book\d+」とか。
スクリプト実行ライブラリにも登録しときました。
お立ち寄りくださいませ～↓↓↓