Sub auto_open()
'
    隠しMenu追加 1

'auto_open に既に他のマクロが記述されている場合には、この１行を追加する
'
End Sub

Sub 隠しMenu追加(num%)
'
' Shirt + ファイル(F) メニューにある「すべて閉じる」機能を標準のファイルメニューに追加する
'   （ただし、隠しメニューには「すべて閉じる」が２つになってしまう）
'
    Dim tmpCBar As CommandBar
    Dim tmpCMenu As CommandBarControl

    Set tmpCBar = Application.CommandBars("Worksheet Menu Bar")
    Set tmpCMenu = tmpCBar.Controls("ファイル(&F)")     'Excel97は”ファイル”を半角に  ←Excel97の方は注意！
'      または、  Set tmpCMenu = tmpCBar.Controls(1) とする 

    With tmpCMenu
        .Controls.Add Type:=msoControlButton, Before:=4, Temporary:=True
        With .Controls(4)
            .Caption = "すべて閉じる(&F)"
            .FaceId = 106
            .OnAction = "CloseAllBooks"
        End With
    End With
'
End Sub

Sub CloseAllBooks()
'
    Dim ws As Variant

    For Each ws In Workbooks
        If ws.Name <> ThisWorkbook.Name Then
            ws.Close
        End If
    Next
'
End Sub

Sub sheet_sort()    'シートを50音順に並べ替える

    '全てのモジュールより前に Option Compare Text という文字列比較をテキストモードにする宣言を忘れないように！

    Dim ws As Variant
    Dim sheet_cnt As Integer
    Dim sheet_name(256) As String       '256シートまでOK（Excelの制限ではない）
    Dim tmp_name As String

    Dim i%
    Dim j%

    sheet_cnt = 0
    For Each ws In Worksheets
        If Sheets(ws.Name).Visible = True Then
            sheet_cnt = sheet_cnt + 1
            sheet_name(sheet_cnt) = ws.Name
        End If
    Next

    If sheet_cnt = 1 Then Exit Sub
    If sheet_cnt > 256 Then Exit Sub

    For i = 1 To sheet_cnt - 1            'いわゆるバカソートです
        For j = i + 1 To sheet_cnt
            If sheet_name(i) > sheet_name(j) Then
                tmp_name = sheet_name(j)
                sheet_name(j) = sheet_name(i)
                sheet_name(i) = tmp_name
            End If
        Next
    Next

    For i = 1 To sheet_cnt - 1
        Sheets(sheet_name(i)).Select
        Sheets(sheet_name(i)).Move Before:=Sheets(i)
    Next

    Sheets(1).Select

End Sub

Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassNams As String, _
                         ByVal lpWindowName As String) As Long

Sub Dentaku()
'
    Dim strClassName As String
    Dim res As Long
    Dim lngProcessId As Long

    strClassName = "SciCalc"
    res = FindWindow(strClassName, vbNullString)

    If res = 0& Then                        '電卓を起動する
        lngProcessId = Shell("Calc.exe", vbNormalFocus)
    Else                                    '既に電卓が立ち上がっているときはアクティブにする
        AppActivate "電卓"
    End If
'
End Sub

Sub font_check()                    'フォント設定一覧作成（オートシェイプの文字は除く）　Option Base 1 が前提
'
    Dim tmpRange As Range
    Dim sheet_name As String
    
    Dim font_settei() As String
    Dim font_address() As String
    
    Dim tmp_font_settei As String
    Dim tmp_font_address As String
    
    Dim tmpCount As Long
    Dim i As Long, j As Long, k As Long
    Dim sort1 As String, sort2 As String
    
    Dim str_macto As String
    
    str_macto = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & _
                vbNewLine & vbTab & "If Target.Row < 3 Or _" & _
                vbNewLine & vbTab & "   Target.Value = " & Chr$(34) & Chr$(34) & " Then" & _
                vbNewLine & vbTab & "    Exit Sub" & _
                vbNewLine & vbTab & "End If" & _
                vbNewLine & vbTab & "Cancel = True" & _
                vbNewLine & vbTab & "Workbooks(" & Chr$(34) & ActiveWorkbook.Name & Chr$(34) & ").Activate" & _
                vbNewLine & vbTab & "Sheets(" & Chr$(34) & ActiveSheet.Name & Chr$(34) & ").Select" & _
                vbNewLine & vbTab & "Workbooks(" & Chr$(34) & ActiveWorkbook.Name & Chr$(34) & ").Sheets(" & Chr$(34) & ActiveSheet.Name & Chr$(34) & ").Range(Target.Value).Select" & _
                vbNewLine & "End Sub"
                
    sheet_name = ActiveSheet.Name
    tmpCount = 0
    For Each tmpRange In ActiveSheet.UsedRange              'UsedRangeは使用している範囲全体が全て選択される
        If Not IsError(tmpRange.Value) Then                 '#VALUE!や#DIV/0!などのエラーがあるとValueが参照できない
            If tmpRange.Value <> "" Then
                tmpCount = tmpCount + 1
            End If
        End If
    Next
    If tmpCount = 0 Then
        MsgBox "文字・数値が入力されているセルがありません"
        Exit Sub
    End If
    
    ReDim font_settei(tmpCount)
    ReDim font_address(tmpCount)
    
    i = 0
    For Each tmpRange In ActiveSheet.UsedRange
        If Not IsError(tmpRange.Value) Then                         '#VALUE!や#DIV/0!などのエラーがあるとValueが参照できない
            If tmpRange.Value <> "" Then
                i = i + 1
                If IsNull(tmpRange.Font.Name) Then                  '1つのセルに複数のフォント種類が混ざっている場合はNullが返る
                    font_settei(i) = "フォント混在"
                Else
                    font_settei(i) = tmpRange.Font.Name
                End If
                If IsNull(tmpRange.Font.Size) Then                  '1つのセルに複数のサイズが混ざっている場合はNullが返る
                    font_settei(i) = font_settei(i) & ",サイズ混在"
                Else
                    font_settei(i) = font_settei(i) & "," & Format(tmpRange.Font.Size, "000.00")
                End If
                font_address(i) = tmpRange.Address(rowabsolute:=False, columnabsolute:=False, ReferenceStyle:=xlA1)
                font_address(i) = Format((tmpRange.Column * 100000 + tmpRange.Row), "0000000") & font_address(i)
            End If
        End If
    Next
    
    If tmpCount < 3 Then
        DoEvents
    Else
        For i = 1 To tmpCount - 1               'いわゆるバカソート
            For j = i + 1 To tmpCount
            
                sort1 = font_settei(i) & font_address(i)
                sort2 = font_settei(j) & font_address(j)
                If sort1 > sort2 Then
                    tmp_font_settei = font_settei(i)
                    tmp_font_address = font_address(i)
                    font_settei(i) = font_settei(j)
                    font_address(i) = font_address(j)
                    font_settei(j) = tmp_font_settei
                    font_address(j) = tmp_font_address
                End If
            Next
        Next
    End If
    
    Workbooks.Add
    Sheets("Sheet1").Name = sheet_name
    Rows("3:3").Select                              '見出し固定
    ActiveWindow.FreezePanes = True
                                                    'マクロ埋め込み
    ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule.AddFromString str_macto
    
    j = 0
    tmp_font_settei = ""
    For k = 1 To tmpCount
        If font_settei(k) <> tmp_font_settei Then
            j = j + 1
            If j > 255 Then
                Exit For
            End If
            Cells(1, j).Value = Left(font_settei(k), InStr(font_settei(k), ",") - 1)
            Cells(2, j).Value = Right(font_settei(k), (Len(font_settei(k)) - InStr(font_settei(k), ",")))
            If Cells(1, j).Value <> "フォント混在" Then
                Columns(j).Font.Name = Cells(1, j).Value        'フォント混在の場合はEXCELに設定した標準フォントとなる
            End If
            If IsNumeric(Cells(2, j).Value) Then
                Columns(j).Font.Size = Cells(2, j).Value        'サイズ混在の場合はEXCELに設定した標準フォントサイズとなる
                Cells(2, j).Value = Cells(2, j).Value & "pt"
            End If
            font_address(k) = Mid(font_address(k), 8)
            Cells(3, j).Value = font_address(k)
            tmp_font_settei = font_settei(k)
            i = 3
        Else
            i = i + 1
            If i > 65536 Then
                Exit For
            End If
            font_address(k) = Mid(font_address(k), 8)
            Cells(i, j).Value = font_address(k)
        End If
    Next
    Rows("1:2").Select
    Selection.Font.Bold = True
    Selection.Font.ColorIndex = 5
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.CurrentRegion.Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    Cells(1.1).Select
    Windows.Arrange ArrangeStyle:=xlArrangeStyleHorizontal
'
End Sub

Sub CellsInformation()                                  '2003/7/7-　選択したセルの情報を表示する
                                                        'アクティブなシートの選択セルのみ有効（対象）
'2004/10/9 文字数表示の追加、各種情報を新規ブックに展開する機能の追加
'2005/3/12 文字数の最大最小値の表示、文字数集計から数値セルを除外（見た目の表示文字数と数値の桁数が異なるため）
'2005/3/12 情報表示ポップアップ及び新規ブック展開時に元シートの選択セルの書式を反映（ただし、日付と通貨書式のみポップアップ表示には反映できず）
'2005/3/12 表示情報を新規ブック上に展開する際、セル番号をダブルクリックすると元シートの該当セルを選択表示するマクロを埋め込み
'2005/3/12 文字形式で日付が入っているとエラーになるバグを改修

    Dim cells_cnt As Long                               'セルの個数
    Dim numeric_cnt As Long                             '数値セルの個数
    Dim data_cnt As Long                                'データの個数（Null以外のセルの個数）
    Dim char_cnt As Long                                '文字数 2004/10/9
    Dim char_max As Long                                '文字数の最大値 2005/3/12
    Dim char_min As Long                                '文字数の最小値 2005/3/12
    Dim num_max As Double                               '数値の最大値
    Dim num_min As Double                               '数値の最小値
    Dim num_ave As Double                               '数値の平均値
    Dim num_sum As Double                               '数値の合計値
    Dim num_max_pos As String                           '数値最大値のセル番地
    Dim num_min_pos As String                           '数値最小値のセル番地
    Dim char_max_pos As String                          '文字数最大値のセル番地 2005/3/12
    Dim char_min_pos As String                          '文字数最小値のセル番地 2005/3/12
    Dim cells_addr() As String                          'セル番地（動的配列）
    Dim disp_format As String                           '数値の表示形式
    Dim cell_format As String                           '新規ブック用の表示形式 2005/3/12
    Dim newbook As New Workbook                         '新規ブック 2004/10/9
    Dim newbook_name As String                          '新規ブック名 2004/10/9
    Dim selected_range_address As String                '選択範囲アドレス 2004/10/9
    Dim str_macto As String                             '埋め込みマクロ用 2005/3/12
    Dim target_address As String                        '埋め込みマクロ用 2005/3/12

    Const cells_cnt_max As Long = 20000                 '警告用セル数最大値

    Dim cells_info As String                            '結果表示用 2005/3/12
    Dim i As Long
    Dim response As Integer                             'MsgBox戻り値用
    Dim tmpCell As Range
    Dim tmpAddr As String

    char_cnt = 0                                        '2004/10/9
    char_min = 0                                        '2005/3/12
    char_max = 0                                        '2005/3/12
    disp_format = ""                                    '2005/3/12
    cell_format = ""                                    '2005/3/12

    If TypeName(Selection) <> "Range" Then Exit Sub     'セル範囲以外を選択している場合は何もせず。
    If Selection.Cells.Count > cells_cnt_max Then       '2003/7/8 2005/3/12
        response = MsgBox("選択範囲のセルが" & cells_cnt_max & "以上あります。" & _
                          vbCr & "処理に時間がかかる可能性があります。" & _
                          vbCr & "処理を続けますか？" & vbCr, vbYesNo + vbExclamation + vbDefaultButton2, _
                          "確認メッセージ")
        If response = vbNo Then
            Exit Sub
        End If
    End If
    ReDim cells_addr(Selection.Cells.Count)             '選択範囲のセルの数で配列確定（この時点では重複あり）
    selected_range_address = Selection.Address          '2004/10/9

    '選択開始位置のセルが文字ではない場合、表示形式を保存 2005/3/12
    If IsNumeric(ActiveCell) Or (IsDate(ActiveCell) And VarType(ActiveCell) <> vbString) Then
        disp_format = ActiveCell.NumberFormatLocal
        cell_format = disp_format
        If InStr(1, disp_format, "G/標準", 1) > 0 Then
            disp_format = ""
            cell_format = ""
        End If          '標準は書式削除 2005/3/12
        If InStr(1, disp_format, "?", 1) > 0 Then disp_format = ""
                        '分数も書式削除（Format関数でうまく変換されないので） 2005/3/12
        If InStr(1, disp_format, "\", 1) > 0 Then
            disp_format = Application.WorksheetFunction.Substitute(disp_format, "\", "")
        End If          '通貨記号も書式削除（Format関数でうまく変換されないので） 2005/3/12
    End If

    For Each tmpCell In Selection.Cells                 '重複を排除しながら配列にセル番地を格納

        tmpAddr = tmpCell.Address(rowabsolute:=False, columnabsolute:=False)
        If cells_cnt = 0 Then
            cells_addr(1) = tmpAddr
            cells_cnt = 1
        Else
            If Selection.Areas.Count = 1 Then           '2003/7/8 選択範囲が１つなら重複チェックをしない
                i = cells_cnt + 1                       '2003/7/8
            Else                                        '2003/7/8
                For i = 1 To cells_cnt
                    If cells_addr(i) = tmpAddr Then
                        Exit For
                    End If
                Next
            End If                                      '2003/7/8
        End If

        If i > cells_cnt Or cells_cnt = 1 Then          '重複が無かった場合
            If i <> 0 Then cells_cnt = i
            cells_addr(cells_cnt) = tmpAddr
            If tmpCell.Value <> "" Then
                data_cnt = data_cnt + 1

                If IsNumeric(tmpCell) Or (IsDate(tmpCell) And VarType(tmpCell) <> vbString) Then
                                                            '文字列の日付は対象外とする 2005/3/12
                    numeric_cnt = numeric_cnt + 1
                    num_sum = num_sum + tmpCell.Value
                    If numeric_cnt = 1 Then
                        num_max = tmpCell.Value
                        num_max_pos = tmpAddr
                        num_min = tmpCell.Value
                        num_min_pos = tmpAddr
                    Else
                        If num_max < tmpCell.Value Then
                            num_max = tmpCell.Value
                            num_max_pos = tmpAddr
                        End If
                        If num_min > tmpCell.Value Then
                            num_min = tmpCell.Value
                            num_min_pos = tmpAddr
                        End If
                    End If
                Else
                    char_cnt = char_cnt + Len(tmpCell.Value)    '2004/10/9
                                                                '数値は集計対象外に 2005/3/12
                    If char_min = 0 Or char_min > Len(tmpCell.Value) Then   '2005/3/12
                        char_min = Len(tmpCell.Value)                       '2005/3/12
                        char_min_pos = tmpAddr                              '2005/3/12
                    End If                                                  '2005/3/12
                    If char_max < Len(tmpCell.Value) Then       '2005/3/12
                        char_max = Len(tmpCell.Value)           '2005/3/12
                        char_max_pos = tmpAddr                  '2005/3/12
                    End If                                      '2005/3/12
                End If

            End If
        End If

    Next

    target_address = Chr$(34) & "$B$1" & Chr$(34) & "," & _
                     Chr$(34) & "$C$9" & Chr$(34) & "," & _
                     Chr$(34) & "$C$10" & Chr$(34) & ","                                                '2005/3/12
    If cell_format <> "" Then                                                                           '2005/3/12
        target_address = target_address & Chr$(34) & "$D$12" & Chr$(34) & "," & _
                                          Chr$(34) & "$D$13" & Chr$(34)                                 '2005/3/12
    Else
        target_address = target_address & Chr$(34) & "$C$12" & Chr$(34) & "," & _
                                          Chr$(34) & "$C$13" & Chr$(34)                                 '2005/3/12
    End If
    str_macto = _
        "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & _
        vbNewLine & vbTab & "If Target.Value <> " & Chr$(34) & Chr$(34) & " Then" & _
        vbNewLine & vbTab & vbTab & "Select Case Target.Address" & _
        vbNewLine & vbTab & vbTab & vbTab & "Case " & target_address & _
        vbNewLine & vbTab & vbTab & vbTab & vbTab & "Cancel = True" & _
        vbNewLine & vbTab & vbTab & vbTab & vbTab & "Workbooks(" & Chr$(34) & ActiveWorkbook.Name & Chr$(34) & ").Activate" & _
        vbNewLine & vbTab & vbTab & vbTab & vbTab & "Sheets(" & Chr$(34) & ActiveSheet.Name & Chr$(34) & ").Select" & _
        vbNewLine & vbTab & vbTab & vbTab & vbTab & "Workbooks(" & Chr$(34) & ActiveWorkbook.Name & Chr$(34) & _
                                        ").Sheets(" & Chr$(34) & ActiveSheet.Name & Chr$(34) & ").Range(Target.Value).Select" & _
        vbNewLine & vbTab & vbTab & vbTab & "Case Else" & _
        vbNewLine & vbTab & vbTab & vbTab & vbTab & "DoEvents" & _
        vbNewLine & vbTab & vbTab & "End Select" & _
        vbNewLine & vbTab & "End If" & _
        vbNewLine & "End Sub"                                                                           '2005/3/12

    On Error GoTo resume_point

    If data_cnt = 0 Then                                            '2005/3/12
        response = MsgBox("セルの個数 = " & cells_cnt & vbCr & _
                          "データの個数 = " & data_cnt & vbCr, _
                          vbYes, "選択セルの情報")                  '2005/3/12
        Exit Sub                                                    '2005/3/12
    End If                                                          '2005/3/12

    cells_info = "セルの個数 = " & cells_cnt & vbCr & _
                 "データの個数 = " & data_cnt & vbCr & vbCr & _
                 "文字セルの個数 = " & data_cnt - numeric_cnt & vbCr & _
                 "数値セルの個数 = " & numeric_cnt & vbCr & vbCr    '2005/3/12

    If data_cnt - numeric_cnt > 0 Then                          '文字列のセルがある場合 2005/3/12
        cells_info = cells_info & "文字数合計 = " & char_cnt & vbCr & _
                                  "文字数最大値 = " & char_max & " [" & char_max_pos & "]" & vbCr & _
                                  "文字数最小値 = " & char_min & " [" & char_min_pos & "]" & vbCr & vbCr
    End If

    If numeric_cnt > 0 Then                                     '数値のセルがある場合 2005/3/12
        num_ave = num_sum / numeric_cnt
        If disp_format <> "" Then                               '選択開始セルが数値セルの場合 2005/3/12
            cells_info = cells_info & _
                         "数値最大値 = " & Format(num_max, disp_format) & _
                         " ( " & num_max & " ) [" & num_max_pos & "]" & vbCr & _
                         "数値最小値 = " & Format(num_min, disp_format) & _
                         " ( " & num_min & " ) [" & num_min_pos & "]" & vbCr & vbCr & _
                         "数値合計 = " & Format(num_sum, disp_format) & _
                         " ( " & num_sum & " )" & vbCr & _
                         "数値平均 = " & Format(num_ave, disp_format) & _
                         " ( " & num_ave & " )" & vbCr & vbCr
        Else
            cells_info = cells_info & _
                         "数値最大値 = " & num_max & " [" & num_max_pos & "]" & vbCr & _
                         "数値最小値 = " & num_min & " [" & num_min_pos & "]" & vbCr & vbCr & _
                         "数値合計 = " & num_sum & vbCr & _
                         "数値平均 = " & num_ave & vbCr & vbCr
        End If
    End If

    cells_info = cells_info & vbCr & "この情報を利用しますか？" & vbCr & vbCr    '2005/3/12
    response = MsgBox(cells_info, vbYesNo + vbInformation + vbDefaultButton2, "選択セルの情報") '2005/3/12
resume_point:

    If Err.Number = 6 Then
        MsgBox "セルと同じ表示形式ではオーバーフローで表示できないため、" & vbCr & _
               "標準書式で表示します"
        cells_info = cells_info & _
                     "数値最大値 = " & num_max & " [" & num_max_pos & "]" & vbCr & _
                     "数値最小値 = " & num_min & " [" & num_min_pos & "]" & vbCr & vbCr & _
                     "数値合計 = " & num_sum & vbCr & _
                     "数値平均 = " & num_ave & vbCr & vbCr
        response = MsgBox(cells_info, vbYesNo + vbInformation + vbDefaultButton2, "選択セルの情報")          '2005/3/12
    End If                                                                                      '2005/3/12

    If response = vbNo Then                                                                             '2004/10/9
        Exit Sub                                                                                        '2004/10/9
    End If                                                                                              '2004/10/9

    Set newbook = Workbooks.Add                             '新規Bookを開く
    newbook_name = newbook.Name                                                                         '2004/10/9
    Workbooks(newbook_name).Activate                                                                    '2004/10/9
    Sheets(1).Select                                                                                    '2004/10/9

    Cells(1, 1).Value = "選択範囲": Cells(1, 2).Value = selected_range_address                          '2004/10/9
    Range("B1").Font.ColorIndex = 5                                                                     '2005/3/12
    Cells(2, 1).Value = "セルの個数": Cells(2, 2).Value = cells_cnt                                     '2004/10/9
    Cells(3, 1).Value = "データの個数": Cells(3, 2).Value = data_cnt                                    '2004/10/9

    Cells(5, 1).Value = "文字セルの個数": Cells(5, 2).Value = data_cnt - numeric_cnt                    '2005/3/12
    Cells(6, 1).Value = "数値セルの個数": Cells(6, 2).Value = numeric_cnt                               '2005/3/12

    Cells(8, 1).Value = "文字数合計": Cells(8, 2).Value = char_cnt                                      '2005/3/12
    Cells(9, 1).Value = "文字数最大値": Cells(9, 2).Value = char_max                                    '2005/3/12
        If data_cnt - numeric_cnt > 0 Then Cells(9, 3).Value = char_max_pos                             '2005/3/12
    Cells(10, 1).Value = "文字数最小値": Cells(10, 2).Value = char_min                                  '2005/3/12
        If data_cnt - numeric_cnt > 0 Then Cells(10, 3).Value = char_min_pos                            '2005/3/12
    Range("C9:C10").Font.ColorIndex = 5                                                                 '2005/3/12

    Cells(12, 1).Value = "数値最大値"                                                                   '2005/3/12
    Cells(13, 1).Value = "数値最小値"                                                                   '2005/3/12
    Cells(15, 1).Value = "数値合計"                                                                     '2005/3/12
    Cells(16, 1).Value = "数値平均"                                                                     '2005/3/12

    If cell_format <> "" Then                                                                           '2005/3/12
        Cells(12, 2).Value = num_max                                                                    '2005/3/12
        Cells(12, 2).NumberFormatLocal = cell_format                                                    '2005/3/12
        Cells(12, 3).Value = num_max                                                                    '2005/3/12
        Cells(12, 4).Value = num_max_pos                                                                '2005/3/12
        Cells(13, 2).Value = num_min                                                                    '2005/3/12
        Cells(13, 2).NumberFormatLocal = cell_format                                                    '2005/3/12
        Cells(13, 3).Value = num_min                                                                    '2005/3/12
        Cells(13, 4).Value = num_min_pos                                                                '2005/3/12
        Cells(15, 2).Value = num_sum                                                                    '2005/3/12
        Cells(15, 2).NumberFormatLocal = cell_format                                                    '2005/3/12
        Cells(15, 3).Value = num_sum                                                                    '2005/3/12
        Cells(16, 2).Value = num_ave                                                                    '2005/3/12
        Cells(16, 2).NumberFormatLocal = cell_format                                                    '2005/3/12
        Cells(16, 3).Value = num_ave                                                                    '2005/3/12
        Range("D12:D13").Font.ColorIndex = 5                                                            '2005/3/12
     Else
        Cells(12, 2).Value = num_max                                                                    '2005/3/12
        Cells(12, 3).Value = num_max_pos                                                                '2005/3/12
        Cells(13, 2).Value = num_min                                                                    '2005/3/12
        Cells(13, 3).Value = num_min_pos                                                                '2005/3/12
        Cells(15, 2).Value = num_sum                                                                    '2005/3/12
        Cells(16, 2).Value = num_ave                                                                    '2005/3/12
        Range("C12:C13").Font.ColorIndex = 5                                                            '2005/3/12
    End If

    Columns("A:D").EntireColumn.AutoFit                                                                 '2005/3/12
    If Columns("B:B").Width > 200 Then Columns("B:B").ColumnWidth = 24.38                               '2005/3/12
    Range("A18").Value = "青字のセル番号をダブルクリックすると、そのセルにカーソルを移動させます"       '2005/3/12
    Range("A18").Font.ColorIndex = 5                                                                    '2005/3/12
    ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule.AddFromString str_macto                  '2005/3/12
    Windows.Arrange ArrangeStyle:=xlArrangeStyleHorizontal                                              '2005/3/12
'
End Sub