Excel操作ライブラリに「名前の管理」を操作する方法がないようだったので書いてみた。
スクリプト実行ライブラリにも追加しておくのでご参照ください。
「名前の管理」を追加する。
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 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 |
' ==== プロパティ ==================================================== 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の機能、[数式]⇒[名前の管理]に設定を追加します。
・すでに同じ名前の定義が設定されている場合は、セル範囲を上書きします。
・同一の名前の定義がない場合は、新規に名前とセル範囲を追加します。