トップ　>　備忘録　>　Excel5.0ダイアログでのセル参照

Excel5.0ダイアログExcel5.0ダイアログシートを用いたセル参照　　　2012.11.10　　　更新：2021.04.12

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

2021.04.12　加筆・修正
こちらのページ内容は、サブスクリプション型のMicrosoft365ではエラーになるとの記事があったため加筆・修正しました。仕様の変更があったようです。

ポイント

・Excel5.0ダイアログシート
・選択中のセルアドレスをEditBoxに表示
・EditBoxが空白時の対応例
・セル参照の文字列からブック名・シート名、セルアドレスを取得
・セル参照範囲とデータで使用しているセル範囲の共通セルを取得
・参照先が複数の場合の対応

●サンプルファイル(Microsoft365に対応)　ダウンロード
Excel5.0ダイアログシートが挿入されており、サンプルコードが記述されているExcelファイル


【お薦め】マクロ・プロシージャを管理する無料のツール！
　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()
    Dim objSp As Shape
    Dim s As String, strSpN As String
    If TypeName(Selection) = "Range" Then
        s = Selection.Areas(1).Address
    End If
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                strSpN = objSp.Name: Exit For
            End If
        Next
        If strSpN = "" Then Exit Sub Else .EditBoxes(strSpN).Caption = s
        If .Show = False Then Exit Sub
        MsgBox .EditBoxes(strSpN).Caption
    End With
End Sub

EditBoxは、上記のEditBoxes(strSpN)のように名前で指定（事前に名前を取得する必要有）。
EditBoxの文字列の取得・設定にはCaptionプロパティを使用。


複数のEditBoxの名前を取得

ダイアログシートに複数のEditBoxが存在する場合の名前の取得。 

Sub E5_Dialog_2_plus()
    Dim objSp As Shape, c As Long, i As Long
    Dim strSpN() As String
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                ReDim Preserve strSpN(c)
                strSpN(c) = objSp.Name
                c = c + 1
            End If
        Next
        If c = 0 Then MsgBox "EditBoxはありません", vbExclamation: Exit Sub
        For i = 0 To c - 1
            MsgBox .EditBoxes(strSpN(i)).Caption
        Next
    End With
End Sub

String型の配列に、EditBoxの名前を動的に取得していく方法です。


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

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

Sub E5_Dialog_3()
    Dim objSp As Shape, strSpN As String
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                strSpN = objSp.Name: Exit For
            End If
        Next
        Do
            If .Show = False Then Exit Sub
        Loop Until 0 < Len(.EditBoxes(strSpN).Caption)
        MsgBox .EditBoxes(strSpN).Caption '参照元セルアドレス
    End With
End Sub

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


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

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

Sub E5_Dialog_4()
    Dim objSp As Shape, strSpN As String
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                strSpN = objSp.Name: Exit For
            End If
        Next
        Do
            If .Show = False Then Exit Sub
        Loop Until 0 < Len(.EditBoxes(strSpN).Caption)
        '参照したセル範囲のセル個数を取得
        MsgBox Application.Range(.EditBoxes(strSpN).Caption).Cells.Count
    End With
End Sub

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


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

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

Sub E5_Dialog_5()
    Dim r As Range, objSp As Shape, strSpN As String
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                strSpN = objSp.Name: Exit For
            End If
        Next
        Do
            If .Show = False Then Exit Sub
        Loop Until 0 < Len(.EditBoxes(strSpN).Caption)
        Set r = Application.Range(.EditBoxes(strSpN).Caption)
    End With
    '///ブック名の取得
    MsgBox r.Parent.Parent.Name
    '///シート名の取得
    MsgBox r.Parent.Name
    '///セルアドレスの取得
    MsgBox r.Address
End Sub

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

セルの参照例



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

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

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

●その他
ブック名、シート名に「'」（シングルクオンテーション）が入っている場合、
ブック名、「!」、「'」、それぞれの前に「'」が追加される。
例）ブック名：Book1　シート名：Sheet'2　セルアドレス：$A$1:$B$3


ワンポイント

セル参照範囲を取得するケースでは、多くの場合データを取得することが目的であると思います。そんな時には「セル参照範囲」と「データで使用しているセル範囲」の共通セルを取得することで、処理の効率化を図れることがあります。 

Sub E5_Dialog_6()
    Dim r As Range, objSp As Shape, strSpN As String
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                strSpN = objSp.Name: Exit For
            End If
        Next
        Do
            If .Show = False Then Exit Sub
        Loop Until 0 < Len(.EditBoxes(strSpN).Caption)
        Set r = Application.Range(.EditBoxes(strSpN).Caption)
    End With
    '///セル参照範囲
    MsgBox r.Address
    '///共通セル範囲の取得
    Set r = Intersect(r, r.Parent.UsedRange)
    If r Is Nothing Then MsgBox "共通セルはありません" Else MsgBox r.Address
End Sub

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

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

Sub E5_Dialog_7()
    Dim r As Range, objSp As Shape, strSpN As String
    Dim s As String, v As Variant, i As Long
    With ThisWorkbook.Sheets("Dialog1")
        For Each objSp In .Shapes
            If 0 < InStr(1, LCase(objSp.Name), "edit") Then
                strSpN = objSp.Name: Exit For
            End If
        Next
        Do
            If .Show = False Then Exit Sub
        Loop Until 0 < Len(.EditBoxes(strSpN).Caption)
        s = .EditBoxes(strSpN).Caption
    End With
    If 0 = InStr(1, s, ",") Then v = s Else v = Split(s, ",")
    If IsArray(v) Then
        For i = LBound(v) To UBound(v)
            Set r = Application.Range(v(i))
            MsgBox r.Parent.Parent.Name & " " & r.Parent.Name & " " & r.Address
        Next
    Else
        Set r = Application.Range(v)
        MsgBox r.Parent.Parent.Name & " " & r.Parent.Name & " " & r.Address
    End If
End Sub

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.