Excel操作ライブラリに「名前の管理」を操作する方法がないようだったので書いてみた。
スクリプト実行ライブラリにも追加しておくのでご参照ください。
「名前の管理」を追加する。
Excelのここから管理するヤツです。（数式タブの「名前の管理」）
動作としては、こんな感じです。
- 同じ名前の定義があればセル範囲の更新する。
- 指定の名前の定義がなければ新たに名前とセル範囲を設定追加する。
- 一応、定義の範囲としてブック・シートが選択できる。
「スクリプト実行」ノードの実装イメージ
スクリプトタブにこれを張り付け。
' ==== プロパティ ====================================================
fname = !ファイル名!
sheetName = !シート名!
AreaName = !名前!
NameScope = !範囲(スコープ)|ブック,シート!
cellAddress = !セル範囲!
' ====指定されたファイルを開く====================================================
' ファイルのパスをフルパスに変換する
Set fso = CreateObject("Scripting.FileSystemObject")
absname = fso.GetAbsolutePathName(fname)
If StrComp(UCase(fname), UCase(absname)) = 0 Then
filePath = absname
Else
folderPath = GetUMSVariable("$SCENARIO-FOLDER")
filePath = fso.GetAbsolutePathName(fso.BuildPath(folderPath, fname))
End If
' workbookオブジェクトを取得する
Set workbook = Nothing
On Error Resume Next
' 既存のエクセルが起動されていれば警告を抑制する
Set existingXlsApp = Nothing
Set existingXlsApp = GetObject(, "Excel.Application")
existingXlsApp.DisplayAlerts = False
' 一先ずWorkbookオブジェクトをGetObjectしてみる
Set workbook = GetObject(filePath)
Set xlsApp = workbook.Parent
' GetObjectによって新規に開かれたWorkbookなら
' 変数にNothingを代入することで参照が0になるため
' 自動的に閉じられる。
Set workbook = Nothing
' Workbookがまだ存在するか確認する
For Each book In xlsApp.Workbooks
If StrComp(book.FullName, filePath, 1) = 0 Then
' Workbookがまだ存在するので、このWorkbookは既に開かれていたもの
Set workbook = book
xlsApp.Visible = True
End If
Next
' Workbookが存在しない場合は、新たに開く。
If workbook Is Nothing Then
Set xlsApp = Nothing
' Excelが既に開かれていたならそれを再利用する
If Not existingXlsApp Is Nothing Then
Set xlsApp = existingXlsApp
xlsApp.Visible = True
Else
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = True
End If
Set workbook = xlsApp.Workbooks.Open(filePath)
End If
' 警告の抑制を元に戻す
existingXlsApp.DisplayAlerts = True
Set existingXlsApp = Nothing
On Error Goto 0
If workbook Is Nothing Then
Err.Raise 1, "", "指定されたファイルを開くことができません。"
End If
' ====指定されたシートを取得する==================================================
Set worksheet = Nothing
On Error Resume Next
' シート名が指定されていない場合は、アクティブシートを対象とする
If sheetName = "" Then
Set worksheet = workbook.ActiveSheet
Else
Set worksheet = workbook.Worksheets(sheetName)
End If
On Error Goto 0
If worksheet Is Nothing Then
Err.Raise 1, "", "指定されたシートが見つかりません。"
End If
worksheet.Activate
' ====指定されたセルを取得する==================================================
Set cell = Nothing
On Error Resume Next
' R1C1形式にも対応する。
Set objRE = CreateObject("VBScript.RegExp")
objRE.IgnoreCase = True
objRE.Pattern = "^R(\d+)C(\d+)$"
Set matches = objRE.Execute(cellAddress)
If matches.Count = 0 Then
Set cell = worksheet.Range(cellAddress)
Else
Set cell = worksheet.Cells(matches(0).SubMatches(0) + 0, matches(0).SubMatches(1) + 0)
End If
On Error Goto 0
If cell Is Nothing Then
Err.Raise 1, "", "指定されたセルが見つかりません。"
End If
' ====ハイライトを表示する========================================================
' HwndプロパティはExcel2002以降のみ対応
On Error Resume Next
ShowUMSHighlight(xlsApp.Hwnd)
On Error Goto 0
' ====名前の定義を追加する==============================================================
Set AppOrSht = Nothing
Set NameObj = Nothing
If NameScope = "ブック" Then
Set AppOrSht = xlsApp
Else
Set AppOrSht = worksheet
End If
For Each nmObj In AppOrSht.Names
If nmObj.Name = AreaName Then
Set NameObj = nmObj
Set NameObj.RefersTo = cell
End If
Next
If NameObj Is Nothing Then
AppOrSht.Names.Add AreaName, cell
End If
Set objRe = Nothing
Set xlsApp = Nothing
Set worksheet = Nothing
Set workbook = Nothing
Set fso = Nothing
注釈タブにはコメントをこんな感じで。
Excelの機能、[数式]⇒[名前の管理]に設定を追加します。
・すでに同じ名前の定義が設定されている場合は、セル範囲を上書きします。
・同一の名前の定義がない場合は、新規に名前とセル範囲を追加します。