1.この記事について
Excelの優秀な機能である名前定義（ctrl+F3で出てくるアレ）がいまいち編集しづらいなと感じた。
理由は、一項目ごとに編集する形式のため、まとめて編集できないこと。
だから、今回作るツールでその課題を克服したい。
※ツールとソースコードはGithubに上げてます（後述）
2.やりたいこと
下記の機能を持ったツール（エクセルツール）の作成。
・指定したブックの名前定義のエクスポート機能（csv形式で出力を想定）
・名前定義のインポート機能（csvを取り込む）
3.使用したツール・環境
Office 2016
4.作成したコード
(1)エクスポート機能
ツール外観はこんな感じ。
実行ボタンを押下後実行される関数を下に記す。
M_NamesExport.bas
Option Explicit
'******************************************************************************************
'*関数名 ：NamesExport
'*機能 ：ブックの名前定義情報をエクスポートしたcsvを出力する。
'* 引数のフォルダに、引数のブックに関連付いた名前定義をエクスポートしたcsvファイルを作成する
'*引数(1) ：出力先フォルダパス
'*引数(2) ：名前定義出力対象のブックオブジェクト
'******************************************************************************************
Public Sub NamesExport(ByVal prmFolderPath As String, _
ByVal prmWB As Workbook)
'定数
Const FUNC_NAME As String = "NamesOutput"
Const ForWriting As Long = 2 '新規書き込み
'変数
Dim outPutCsvPath As String
On Error GoTo ErrorHandler
'---以下に処理を記述---
With CreateObject("Scripting.FileSystemObject")
'出力csvのパスを設定
outPutCsvPath = (prmFolderPath & "\" & .GetBaseName(prmWB.Name) & "_Names.csv")
'csvファイルを作成する
'すでに同名ファイルが存在する場合は上書きの可否を問う
If .FileExists(outPutCsvPath) Then
If MsgBox("上書きします。" & vbLf & "よろしいですか。", vbYesNo) = vbNo Then
GoTo ExitHandler
End If
End If
.CreateTextFile (outPutCsvPath)
'csvファイルを開く
With .OpenTextFile(outPutCsvPath, ForWriting, True)
'名前定義の書き込み
.Write NamesExport_Sub_PullNamesData(prmWB)
.Close
End With
End With
MsgBox "エクスポートが完了しました。"
ExitHandler:
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しましたので終了します" & _
vbLf & _
"関数名：" & FUNC_NAME & _
vbLf & _
"エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
GoTo ExitHandler
End Sub
'******************************************************************************************
'*関数名 ：NamesExport_Sub_PullNamesData
'*機能 ：引数のブックの名前定義データをcsv形式文字列として取得
'*引数(1) ：対象のブックオブジェクト
'*戻り値 ：csv形式文字列
'******************************************************************************************
Private Function NamesExport_Sub_PullNamesData(ByVal prmWB As Workbook) As String
'定数
Const FUNC_NAME As String = "NamesOutput_Sub_PullNamesData"
'変数
Dim cnt As Long
Dim tempStr As String
On Error GoTo ErrorHandler
'戻り値初期値
NamesExport_Sub_PullNamesData = ""
'---以下に処理を記述---
'csvヘッダーを設定
tempStr = """名前""" & DELIMITER & _
"""参照範囲（A1）""" & DELIMITER & _
"""参照範囲（R1C1）""" & DELIMITER & _
"""コメント"""
tempStr = tempStr & vbCrLf
'定義された名前の数だけループ
For cnt = 1 To prmWB.Names.Count
'ブック範囲の名前定義のみ抽出
If TypeName(prmWB.Names(cnt).Parent) = "Workbook" Then
'情報取得
tempStr = tempStr & prmWB.Names(cnt).Name & DELIMITER & _
prmWB.Names(cnt).RefersTo & DELIMITER & _
prmWB.Names(cnt).RefersToR1C1 & DELIMITER & _
prmWB.Names(cnt).Comment
'改行設定
tempStr = tempStr & vbCrLf
End If
Next
'最後の改行コードを除去
tempStr = Mid(tempStr, 1, Len(tempStr) - 2)
'戻り値設定
NamesExport_Sub_PullNamesData = tempStr
ExitHandler:
Exit Function
ErrorHandler:
MsgBox "エラーが発生しましたので終了します" & _
vbLf & _
"関数名：" & FUNC_NAME & _
vbLf & _
"エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
GoTo ExitHandler
End Function
(2)インポート機能
外観はエクスポートのほうとほぼ同じ。
実行ボタン押下後作動する関数を下に記す。
M_NamesImport.bas
Option Explicit
'******************************************************************************************
'*関数名 ：NamesImport
'*機能 ：csvファイルの名前定義を読み取り、指定したブックの名前定義設定に新しく取得した名前定義をインポートする。
'*引数(1) ：csvファイルのパス
'*引数(2) ：インポート対象ブックオブジェクト
'******************************************************************************************
Public Sub NamesImport(ByVal prmCsvFilePath As String, _
ByRef prmWB As Workbook)
'定数
Const FUNC_NAME As String = "NamesInput"
'変数
Dim namesArr As Variant
Dim cnt As Long
On Error GoTo ErrorHandler
'---以下に処理を記述---
'csv読み込み
namesArr = NamesImport_Sub_CsvToArray(prmCsvFilePath)
'指定したブックの名前定義設定に新しく取得した名前定義を挿入する
For cnt = LBound(namesArr, 1) To UBound(namesArr, 1)
'参照形式ごとに処理を分岐
Select Case Application.ReferenceStyle
Case xlA1
prmWB.Names.Add namesArr(cnt, 0), namesArr(cnt, 1), True
Case Else
prmWB.Names.Add Name:=namesArr(cnt, 0), RefersToR1C1:=namesArr(cnt, 2), Visible:=True
End Select
'コメントを設定
prmWB.Names(namesArr(cnt, 0)).Comment = namesArr(cnt, 3)
Next
MsgBox "名前定義のインポートを完了しました。"
ExitHandler:
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しましたので終了します" & _
vbLf & _
"関数名：" & FUNC_NAME & _
vbLf & _
"エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
GoTo ExitHandler
End Sub
'******************************************************************************************
'*関数名 ：NamesImport_Sub_CsvToArray
'*機能 ：csvファイルの内容を二次元配列に格納
'*引数(1) ：csvファイルパス
'*戻り値 ：二次元配列
'******************************************************************************************
Private Function NamesImport_Sub_CsvToArray(ByVal prmCsvFilePath As String) As Variant
'定数
Const FUNC_NAME As String = "NamesInput_Sub_CsvToArray"
'変数
Dim strArr() As String
Dim lineArr As Variant
Dim iFile As Long
Dim buf As String
Dim cnt_1 As Long
Dim cnt_2 As Long
Dim tempNum As Long
On Error GoTo ErrorHandler
'---以下に処理を記述---
'初期化
cnt_1 = 0
cnt_2 = 0
'ファイル番号取得
iFile = FreeFile
'csvファイルの行数取得
With CreateObject("Scripting.FileSystemObject").OpenTextFile(prmCsvFilePath, 8)
tempNum = .Line
End With
'Redim
ReDim strArr(tempNum - 2, 3)
'csvを開き、データを行数分配列に格納
Open prmCsvFilePath For Input As #iFile
Do Until EOF(iFile)
Line Input #iFile, buf
'ヘッダー行は無視する
If cnt_1 <> 0 Then
lineArr = Split(buf, DELIMITER)
For cnt_2 = 0 To UBound(lineArr)
strArr(cnt_1 - 1, cnt_2) = lineArr(cnt_2)
Next cnt_2
End If
cnt_1 = cnt_1 + 1
Loop
Close #iFile
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
'下記処理はエラーになる：VBAでは二次元配列に対してのRedimは最後の次元の要素数のみ許容
' '使用していない配列をリサイズする
' tempNum = cnt_1 - 1
' ReDim Preserve strArr(tempNum, 3)
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
'戻り値設定
NamesImport_Sub_CsvToArray = strArr
ExitHandler:
Exit Function
ErrorHandler:
MsgBox "エラーが発生しましたので終了します" & _
vbLf & _
"関数名：" & FUNC_NAME & _
vbLf & _
"エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
GoTo ExitHandler
End Function
5.解説
エクスポート機能
名前定義にはブック範囲とシート範囲のものがあるが、
今回はインポート時の煩雑さを考慮しブック範囲にのみ対応とした。
これで出力されるcsvはテキストファイルなので、
豊富な編集機能のあるテキストエディタで自由自在に編集できる。
インポート機能
同じ名前で違う参照範囲を持つ名前定義がすでに存在する場合は
上書きを行う（参照範囲は新しい方のものが反映される）。
また、今回インポートされるのは名前定義のプロパティのうち主だった「３種類」のみなので、
他のプロパティを残そうとするならばソースコードの改良が必要（そこまで難易度は高くないかと思うけど）。
6.終わりに
今回のツール及びソースコードをGithubに上げました。
GitHub
なにか補足がありましたらコメントください。