Memorandum

Excel5.0ダイアログExcel5.0ダイアログシートを用いたセル参照

「Excel5.0ダイアログ」は、古いバージョンのExcelで、現在のユーザーフォーム代わりに使用されていたものです。OptionButtonやTextBox(5.0ではEditBoxと呼ばれる)等が配置でき、マクロで制御します。
ユーザーフォームの方が拡張性が高く、イベントドリブン型のプログラムを使用できるため、私は基本的にフォームを使用していますが、セル参照のための「RefEdit」コントロールはエラーが多いため使用していません。
そのため、プログラムでユーザーにセルを参照してもらう場合、「Excel5.0ダイアログ」使用しています。これはExcel5.0ダイアログで、セル参照するためのメモとサンプルコードです。

ポイント

・Excel5.0ダイアログシート
・選択中のセルアドレスをEditBoxに表示
・EditBoxが空白時の対応例
・セル参照の文字列をブック名・シート名、セルアドレスに分割
・名前の定義されたセルのアドレス表示
・列をセルアドレスに変換
・参照先が複数の場合の対応

[サンプルファイル] 30kb
Excel5.0ダイアログシートが挿入されており、サンプルコードが記述されているExcelファイル


Excel5.0ダイアログシートの挿入

1.シートタブを右クリック
2.挿入を選択→「挿入」ダイアログが表示される
3.「MS Excel5.0 ダイアログ」を選択し「OK」

EditBoxの挿入

1.「開発」タブを選択
2.挿入をクリック
3.「フォームコントロール」の「テキストフィールド」を選択
4.ダイアログシートの任意の場所をクリック→EditBoxが挿入される

EditBoxの属性選択

EditBoxを右クリックし「コントロールの書式設定」をクリック
「コントロールの書式設定」ダイアログが表示される


ダイアログの「コントロール」タブを選択し、「入力できるデータ」を「参照先」に設定し「OK」


Excel5.0ダイアログの表示

表示にはマクロを使用。以下はサンプルコード。 ※"Dialog1"はシート名

Sub E5_Dialog_1()
    If ThisWorkbook.Sheets("Dialog1").Show = False Then Exit Sub
End Sub

上記のマクロの実行結果

・ダイアログの「キャンセル」ボタンをクリックすると、「False」が返る。
・セル範囲とは関係のない文字列を入力し「OK」をクリックすると、エラーが表示。

EditBox右端のボタンを押すと、下図のようにダイアログが折りたたむ。


EditBoxに選択中のセルアドレスを表示

ダイアログ表示時に、EditBoxに選択中のセルアドレスを表示するサンプルコード

Sub E5_Dialog_2()
    With ThisWorkbook.Sheets("Dialog1")
        .EditBoxes(1).Text = Selection_Address()
        If .Show = False Then Exit Sub
        MsgBox .EditBoxes(1).Text
    End With
End Sub

Private Function Selection_Address() As String With Excel.Application If TypeName(.Selection) = "Range" Then Selection_Address = .Selection.Areas(1).Address End If End With End Function

EditBoxは、上記のEditBoxes(1)のようにIndexで指定。
EditBoxの文字列の取得・設定にはTextプロパティを使用。


EditBoxが空白で「OK」を押した場合の対応

EditBoxが空白だと、再度ダイアログを表示するサンプルコード

Sub E5_Dialog_3()
    With ThisWorkbook.Sheets("Dialog1")
        Do
            If .Show = False Then Exit Sub
            If Len(.EditBoxes(1).Text) <> 0 Then Exit Do
        Loop
        MsgBox .EditBoxes(1).Text '参照元セルアドレス
    End With
End Sub

ダイアログを閉じた時に、EditBoxの値を調べ、空白の場合はDo~Loopで再度表示。


参照したセルアドレスから該当セルのプロパティを取得・設定

参照文字列から、該当セル範囲のセルの個数を取得するサンプルコード

Sub E5_Dialog_4()
    With ThisWorkbook.Sheets("Dialog1")
        Do
            If .Show = False Then Exit Sub
            If Len(.EditBoxes(1).Text) <> 0 Then Exit Do
        Loop
        '参照したセル範囲のセル個数を取得
        MsgBox Application.Range(.EditBoxes(1).Text).Cells.Count
    End With
End Sub

他ブック・他シートのセル参照も可能。


参照したセルアドレスからブック名・シート名・セルアドレスを取得

参照文字列から、シート名、セルアドレスを取得

Sub E5_Dialog_5_1()
    With ThisWorkbook.Sheets("Dialog1")
        Do
            If .Show = False Then Exit Sub
            If Len(.EditBoxes(1).Text) <> 0 Then Exit Do
        Loop
        'シート名の取得
        MsgBox Application.Range(.EditBoxes(1).Text).Worksheet.Name
        'セルアドレスの取得
        MsgBox Application.Range(.EditBoxes(1).Text).Address
    End With
End Sub

ブック名の取得には、セル参照の書式を知る必要がある。

セルの参照例



●ブック名
他ブックを参照した場合は、ブック名の前後に [ ] が付く。

●シート名
他シートを参照した場合、シート名の後に「!」が付く。

●セルアドレス
A1形式で、行列ともに絶対参照の「$」が付く。
複数範囲を選択の場合は「,」で区切られる。

●その他
ブック名、シート名に「'」(シングルクオンテーション)が入っている場合、
ブック名、「!」、「'」それぞれの前に、「'」が追加される。

シート名に「'」が入っている(Sheet'2)の場合の参照例



参照文字列から、ブック名・シート名・セルアドレスを取得するサンプルコード

Sub E5_Dialog_5_2()
    Dim strBookName As String
    Dim strSheetName As String
    Dim strAreaAddress As String
    With ThisWorkbook.Sheets("Dialog1")
        Do
            If .Show = False Then Exit Sub
            If Len(.EditBoxes(1).Text) <> 0 Then Exit Do
        Loop
        With .EditBoxes(1)
            'ブック・シート名、セルアドレスの取得
            strBookName = Get_BookName(.Text)
            strSheetName = Range(.Text).Worksheet.Name
            strAreaAddress = Range(.Text).Address
        End With
        strBookName = "ブック名:" & strBookName & vbCrLf
        strSheetName = "シート名:" & strSheetName & vbCrLf
        strAreaAddress = "セルアドレス:" & strAreaAddress
        MsgBox strBookName & strSheetName & strAreaAddress
    End With
End Sub

Private Function Get_BookName(ByVal ET As String) As String 'ブック名を返す Dim lngBookSepF As Long Dim lngBookSepE As Long Dim strBN As String lngBookSepF = InStr(1, ET, "[", vbBinaryCompare) lngBookSepE = InStrRev(ET, "]", -1, vbBinaryCompare) If lngBookSepE = 0 Then strBN = Excel.Application.ActiveWorkbook.Name Else strBN = Mid$(ET, lngBookSepF + 1, lngBookSepE - (lngBookSepF + 1)) End If Get_BookName = Sgl_String_Search(strBN) End Function
Private Function Sgl_String_Search(ByVal objName As String) As String Dim lngStrCount As Long Dim bolStrFlg As Boolean Dim strString As String Const conSgl As String = "'" If InStr(1, objName, conSgl, vbBinaryCompare) <> 0 Then If Left$(objName, 1) = conSgl Then objName = Mid$(objName, 2) If Right$(objName, 1) = conSgl Then objName = Left$(objName, Len(objName) - 1) If InStr(1, objName, conSgl, vbBinaryCompare) <> 0 Then Do lngStrCount = lngStrCount + 1 strString = Mid$(objName, lngStrCount, 1) If strString = conSgl Then If bolStrFlg Then objName = Left$(objName, lngStrCount - 1) & Mid$(objName, lngStrCount + 1) lngStrCount = lngStrCount - 1 bolStrFlg = False Else bolStrFlg = True End If End If If Len(objName) < lngStrCount Then Exit Do Loop End If End If Sgl_String_Search = objName End Function

他ブックを参照しない場合はアクティブブック名、他シートを参照しない場合はアクティブシート名を返す。
シングルクオンテーションの処理が重要。


列をセルアドレスに変換

列を参照した場合に、列をセルアドレスに変換するサンプルコード。その後の処理を考慮し、変換後のセル範囲は、そのシートで使用しているセルの中で、最も下のセルを基準している。

Sub E5_Dialog_6()
    Dim i As Long
    Dim strBookName As String
    Dim strSheetName As String
    Dim strAreaName As String
    With ThisWorkbook.Sheets("Dialog1")
        Do
            If .Show = False Then Exit Sub
            If Len(.EditBoxes(1).Text) <> 0 Then Exit Do
        Loop
        strBookName = ActiveWorkbook.Name
        strSheetName = ActiveSheet.Name
        strAreaName = .EditBoxes(1).Text
        i = InStrRev(strAreaName, "!")
        If i <> 0 Then strAreaName = Mid$(strAreaName, i + 1)
        strAreaName = Col_Cell_Address(strBookName, strSheetName, strAreaName)
        MsgBox strAreaName 
    End With
End Sub

Private Function Col_Cell_Address(WB As String, SH As String, AN As String) As String Dim lngInstr As Long Dim strClAdS As String Dim strClAdE As String Dim bolSpCell As Boolean Col_Cell_Address = AN With Excel.Application.Workbooks(WB).Worksheets(SH) lngInstr = InStr(1, AN, ":", vbBinaryCompare) '「:」を探す If lngInstr = 0 Then Exit Function '列を選択した場合、それをセル範囲のアドレスに変換 If Not IsNumeric(Mid$(AN, lngInstr - 1, 1)) Then strClAdS = Left$(AN, lngInstr - 1) strClAdE = Mid$(AN, lngInstr + 1) If Left$(strClAdS, 1) = "$" Then Else strClAdS = "$" & strClAdS If Left$(strClAdE, 1) = "$" Then Else strClAdE = "$" & strClAdE lngInstr = .Cells.SpecialCells(xlCellTypeLastCell).Row Col_Cell_Address = strClAdS & "$1" & ":" & strClAdE & "$" & lngInstr End If End With End Function
サンプルでは、アクティブブック・アクティブシートを元にしている。


参照元のセル範囲が複数の場合の対応

参照元のセル範囲が、複数の場合の対応処理サンプルコード。セル参照が複数の場合「,」で区切られる。

Sub E5_Dialog_7()
    Dim i As Long
    Dim strCheckCol As String
    Dim strBookName As String
    Dim strSheetName As String
    Dim strAreaName As String
    Dim strEditText As String
    Dim varEditText As Variant
    Dim varArray(0 To 0) As Variant
    With ThisWorkbook.Sheets("Dialog1")
        Do
            If .Show = False Then Exit Sub
            If Len(.EditBoxes(1).Text) <> 0 Then Exit Do
        Loop
        strEditText = .EditBoxes(1).Text
    End With
    If Len(strEditText) = 0 Then Exit Sub
    If InStr(1, strEditText, ",", vbBinaryCompare) = 0 Then
        'ひとつのセル範囲
        varArray(0) = strEditText
        varEditText = varArray
    Else
        '複数のセル範囲
        varEditText = Split(strEditText, ",")
    End If
    For i = LBound(varEditText) To UBound(varEditText)
        strEditText = varEditText(i)
        'ブック・シート名、セルアドレスの取得
        strBookName = Get_BookName(strEditText)
        strSheetName = Range(.Text).Worksheet.Name
        strAreaName = Range(.Text).Address
        strBookName = "ブック名:" & strBookName & vbCrLf
        strSheetName = "シート名:" & strSheetName & vbCrLf
        strAreaName = "セルアドレス:" & strAreaName
        MsgBox strBookName & strSheetName & strAreaName
    Next
End Sub

Private Function Get_BookName(ByVal ET As String) As String 'ブック名を返す Dim lngBookSepF As Long Dim lngBookSepE As Long Dim strBN As String lngBookSepF = InStr(1, ET, "[", vbBinaryCompare) lngBookSepE = InStrRev(ET, "]", -1, vbBinaryCompare) If lngBookSepE = 0 Then strBN = Excel.Application.ActiveWorkbook.Name Else strBN = Mid$(ET, lngBookSepF + 1, lngBookSepE - (lngBookSepF + 1)) End If Get_BookName = Sgl_String_Search(strBN) End Function
Private Function Sgl_String_Search(ByVal objName As String) As String Dim lngStrCount As Long Dim bolStrFlg As Boolean Dim strString As String Const conSgl As String = "'" If InStr(1, objName, conSgl, vbBinaryCompare) <> 0 Then If Left$(objName, 1) = conSgl Then objName = Mid$(objName, 2) If Right$(objName, 1) = conSgl Then objName = Left$(objName, Len(objName) - 1) If InStr(1, objName, conSgl, vbBinaryCompare) <> 0 Then Do lngStrCount = lngStrCount + 1 strString = Mid$(objName, lngStrCount, 1) If strString = conSgl Then If bolStrFlg Then objName = Left$(objName, lngStrCount - 1) & Mid$(objName, lngStrCount + 1) lngStrCount = lngStrCount - 1 bolStrFlg = False Else bolStrFlg = True End If End If If Len(objName) < lngStrCount Then Exit Do Loop End If End If Sgl_String_Search = objName End Function
ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.