別の人から２回、同じこと質問されたから記事にしてみる。
１．お悩み
システムから生成されて起動したExcelを名前付けて保存したいけど、
Excel操作のライブラリはファイル名指定になってて新規ブックの保存ができません。
なるほど、確かにそーだね。
２．方法① エミュレーションしちゃいなよ。
前回は、この方法でアドバイスした。
そのウィンドウ、エミュレーションで「Ctrl + S」しちゃいなヨ。
新規ブックは、ウィンドウタイトルの数字がBook1とかBook2とか、変わったりするからウィンドウ識別ルールでタイトルの部分の指定を編集するといいですよ。って。
３．方法② スクリプト書いてみたよ。
これは、Excelでだけ使えるスクリプトだけどね。
エミュレーションで「Ctrl + S」だと、名前を付けて保存ダイアログ自分で操作しなきゃいけないしね。
18_Excel関連 - 新しいブックに名前を付けて保存
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
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+」とか。
スクリプト実行ライブラリにも登録しときました。
お立ち寄りくださいませ～↓↓↓