[WinActor]Excel操作 – 名前の管理から削除

[WinActor]Excel操作 – 名前の管理へ追加

「名前の管理へ追加」を書いたので、セットで削除も書いてみた。

こちらもスクリプト実行ライブラリには登録しておきます。

[WINACTOR]スクリプト実行ライブラリ

「名前の管理」から削除する。

• 指定の名前で「名前の管理」に登録されている定義を削除する。
• 指定の名前の登録がなかったとしても何も起きない。（あった時だけ消える。）
• 範囲のブック or シートが合ってないと消えません。

「スクリプト実行」ノードの実装イメージ

スクリプト実行タブにこれを張り付け。

' ==== プロパティ ====================================================
fname = !ファイル名!
sheetName = !シート名!
AreaName = !名前!
NameScope = !範囲(スコープ)|ブック,シート!

' ====指定されたファイルを開く====================================================

' ファイルのパスをフルパスに変換する
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

' ====ハイライトを表示する========================================================

' HwndプロパティはExcel2002以降のみ対応
On Error Resume Next
  ShowUMSHighlight(xlsApp.Hwnd)
On Error Goto 0

' ====名前の定義を追加する==============================================================

Set AppOrSht = Nothing

If NameScope = "ブック" Then
  Set AppOrSht = xlsApp
Else
  Set AppOrSht = worksheet
End If

For Each nmObj In AppOrSht.Names
  If nmObj.Name = AreaName Then
    nmObj.Delete
  End If
Next

Set objRe = Nothing
Set xlsApp = Nothing
Set worksheet = Nothing
Set workbook = Nothing
Set fso = Nothing

注釈タブにはコメントをこんな感じで。

Excelの機能、[数式]⇒[名前の管理]の設定を削除します。

・指定の名前で「名前の管理」に登録されている定義を削除する。
・指定の名前の登録がなかったとしても何も起きない。（あった時だけ消える。）
・範囲のブック or シートが合ってないと消えません。