【Excel VBA】エクセルの名前定義をインポート/エクスポートできるツールを作成したい

#1.この記事について
Excelの優秀な機能である名前定義（ctrl+F3で出てくるアレ）がいまいち編集しづらいなと感じた。
理由は、一項目ごとに編集する形式のため、まとめて編集できないこと。

だから、今回作るツールでその課題を克服したい。
######[※ツールとソースコードはGithubに上げてます（後述）](https://qiita.com/dede-20191130/items/0a4b14d03b1b2de76ab7#6%E7%B5%82%E3%82%8F%E3%82%8A%E3%81%AB)


#2.やりたいこと
下記の機能を持ったツール（エクセルツール）の作成。
・指定したブックの名前定義のエクスポート機能（csv形式で出力を想定）
・名前定義のインポート機能（csvを取り込む）

#3.使用したツール・環境
Office 2016

#4.作成したコード
##(1)エクスポート機能

ツール外観はこんな感じ。![コメント 2019-12-22 000531.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/8937999c-7a24-9fb4-6dfc-b03703c4b817.png)
<hr>
実行ボタンを押下後実行される関数を下に記す。

```vb: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


```
<hr>
##(2)インポート機能

外観はエクスポートのほうとほぼ同じ。
実行ボタン押下後作動する関数を下に記す。

```vb: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](https://github.com/dede-20191130/MyExcelVBA/blob/master/forQiita/20191222/%E5%90%8D%E5%89%8D%E3%82%92csv%E3%81%A7%E7%AE%A1%E7%90%86%E3%81%99%E3%82%8B%E3%83%84%E3%83%BC%E3%83%AB.xlsm)

なにか補足がありましたらコメントください。