Attribute VB_Name = "MOD_ADDIN"
'■　マクロ５００連発＜第２段＞
'
'　ユーザーインターフェースを持つ独自アドインを作成する
'　(アドイン本体）
'
'  Copyright(C) 2000 Sunago
'

Option Explicit

'/* 選択範囲をテキストファイルへ出力する */

Public Sub TextFile_Output()
Dim OutFile
Dim myArray As Variant, myRecord As String
Dim myRow, myCol

    ' 選択範囲の値を myArray に格納する
    myArray = Selection.Value
    If Not IsArray(myArray) Then
        MsgBox "選択範囲が不適切です", vbOKOnly + vbCritical, "ﾌｧｲﾙ出力ｱﾄﾞｲﾝ"
        Exit Sub
    End If
    ' 出力ファイル名を取得する
    OutFile = _
        InputBox("絶対パスで指定してください（ex. C:\myount.txt)", _
                "保存ファイルの選択")
    
    If OutFile = False Or OutFile = "" Then Exit Sub
    On Error GoTo Macro1_Err
    Open OutFile For Output As #1
    On Error GoTo 0
    For myRow = 1 To UBound(myArray, 1)
        myRecord = ""
        For myCol = 1 To UBound(myArray, 2)
            If myCol = 1 Then
                myRecord = """" & myArray(myRow, 1) & """"
              Else
                myRecord = myRecord & ",""" & myArray(myRow, myCol) & """"
            End If
        Next myCol
        Print #1, myRecord
    Next myRow
    Close #1
    MsgBox "正常終了です", vbOKOnly + vbInformation, "ﾌｧｲﾙ出力ｱﾄﾞｲﾝ"
    Exit Sub
    
Macro1_Err:
    MsgBox "ﾌｧｲﾙ作成に失敗しました！", vbOKOnly + vbCritical, "ﾌｧｲﾙ出力ｱﾄﾞｲﾝ"
    Exit Sub
End Sub

'/* アドイン追加時の処理 */
' （拡張ﾒﾆｭｰの追加）
Sub Auto_Add()
Dim myBar As CommandBar, cstMenu As CommandBarControl

    On Error Resume Next
    Set myBar = CommandBars("Worksheet Menu Bar")
    myBar.Enabled = True
    '//拡張ﾒﾆｭｰ(&Z)を追加する
    Set cstMenu = myBar.Controls.Add(Type:=msoControlPopup)
    cstMenu.Caption = "拡張ﾒﾆｭｰ(&Z)"
    With cstMenu
        .Controls.Add Type:=msoControlButton
        .Controls(1).Caption = "ﾌｧｲﾙ出力ｱﾄﾞｲﾝ(&O)"
        .Controls(1).OnAction = "TextFile_Output"
        .Controls(1).FaceId = 2950
    End With
    On Error GoTo 0
End Sub

'/* アドイン解除時の処理 */
' （拡張ﾒﾆｭｰの削除)
Sub Auto_Remove()
Dim myBar As CommandBar

    On Error Resume Next
    Set myBar = CommandBars("Worksheet Menu Bar")
    myBar.Enabled = True
    '//ｶｽﾀﾑﾒﾆｭｰ(&Z)
    myBar.Controls("拡張ﾒﾆｭｰ(&Z)").Delete
    On Error GoTo 0
End Sub


Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　ユーザーインターフェースを持つ独自アドインを作成する
'　(読み出し側）
'
'  Copyright(C) 2000 Sunago
'
Option Explicit

'/* アドインを組み込む */

Sub Macro1()
Dim strfile As String

    strfile = Path(ThisWorkbook.Path) & "491.xla"
    'アドインを新規登録し、組み込みを行う
    AddIns.Add(strfile).Installed = True

End Sub

'/* アドインを解除する */
Sub Macro1_Reset()
Dim strfile As String

    strfile = Path(ThisWorkbook.Path) & "491.xla"
    '解除時はインデックス番号かタイトルで指定する
    AddIns("ExcelVBAマクロ500連発・第2弾").Installed = False

End Sub

'/* パスの終わりを\にする関数 */
Function Path(arg1) As String
    
    If Right(arg1, 1) = "\" Then
        Path = arg1
    Else
        Path = arg1 & "\"
    End If
End Function