UserForm のコピーを作成する方法について勉強しましたが
手動で全く同じユーザーフォームを作成するには各コントロールの大きさや配置などを全く同じにしなければなりません。手動でそのデータを取得・設定するのは結構な手間がかかることがわかりました。
VBAを使って一括でコントロール値を取得できないかどうか検討してみたいと思います。
UserForm自体の各プロパティー値と配置している各コントロールの値まですべて取得するようにできれば、そのデータを使って設定することもできそうですね(^^)
まずは、取得する方法を考えていきましょう、
わかりました。よろしくお願いしますm(__)m
前回記事の「UserForm のコピーを作成する方法」がこちらです。
【この記事でわかることは】
・UserForm の全プロパティをVBAで取得する方法
・各コントロールの全プロパティーをVBAで取得する方法
UserForm と配置コントロールの全プロパティ値をVBAで取得する
前回同様この UserForm を使ってテストしていきます。
UserForm1 には Frame1、Label1、Label2、CommandButton1 が配置されています。
UserForm1 のプロパティ
UserForm
(オブジェクト名)
BackColor
BorderColor
BorderStyle
Caption
Cycle
DrawBuffer
Enabled
Font
ForeColor
Height
HelpConTextID
KeepScrollbarsVisible
Left
MouseIcon
MousePointe
Picture
pictureAlignment
PictureSizeMode
PictureTiling
RightToLeft
ScrollBars
ScrollHeight
ScrollLeft
ScrollTop
ScrollWidth
ShowModal
SpecialEffect
StartUpPosition
Tag
WhatThisButton
WhatThisHelp
Width
Zoom
合計33種類あります
文字を青色にしている「Font」はオブジェクトで、次のプロパティがあります。
Font.Name、 Font.Size、Font.Bold、Font.Italic、Font.Strikethrough、Font.Underline
「Font」には「Font.Color」などもっとたくさんのプロパティがあるのですが、UserForm で使われているのはこれらのようです。
これも種類にプラスすると 38種類(オブジェクトを除いて)ということです。
コントロールのプロパティ
基本となる取得すべきコントロール等のプロパティをピックアップしました。
コントロールの種類
検証したコントロールの種類がこちらです。
UserFormを含めて18種類(基本コントロール15種類+ActiveXのコントロール2種類)です。
UserForm | Label | CommandButton | ToggleButton | Frame | TabStrip | MultiPage | CheckBox | OptionButton | RefEdit | TextBox | ComboBox | ListBox | ScrollBar | SpinButton | Image | ListView | ProgressBar |
コントロールの全プロパティ
各コントロールのプロパティを全てリストアップした種類は次の 122種類 ありました。
Accelerator | Alignment | AllowColumnReorder | Appearance | Arrenge | AutoSize | AutoTab | AutoWordSelect | BackColor | BackStyle | BorderColor | BorderStyle | BoundColumn | Cancel | Caption | Checkboxes | ColumnCount | ColumnHeads | ColumnWidths | ControlSource | ControlTipText | Cycle | Default | Delay | DragBehavior | DrawBuffer | DropButtonStyle | Enabled | EnterFieldBehavior | EnterKeyBehavior | FlatScrollBar | Font | FontSize | FontBold | FontItalic | FontStrikethrough | FontUnderline | ForeColor | FullRowSlect | GridLines | GroupName | Height | HelpConTextID | HideColumnHeaders | HideSelection | HotTracking | HoverSelection | IMEMode | IntegralHeight | KeepScrollbarsVisible | LabelEdit | LabelWrap | LargeChange | Left | ListRows | ListStyle | ListWidth | Locked | MatchEntry | MatchRequired | Max | MaxLength | Min | MouseIcon | MousePointer | MultiLine | MultiRow | MultiSelect | OLEDragMode | OLEDropMode | Orientation | PasswordChar | Picture | pictureAlignment | PicturePosition | PictureSizeMode | PictureTiling | ProportionalThumb | RightToLeft | RowSource | ScrollBars | ScrollHeight | Scrolling | ScrollLeft | ScrollTop | ScrollWidth | SelectionMargin | SelLength | SelStart | SelText | ShowDropButtonWhen | ShowModal | SmallChange | Sorted | SortKey | SortOder | SpecialEffect | StartUpPosition | Style | TabFixedHeight | TabFixedWidth | TabIndex | TabKeyBehavior | TabOrientationTop | TabStop | Tag | TakeFocusOnClick | Text | TextAlign | TextBackground | TextColumn | Top | TopIndex | TriPleState | Value | View | Visible | WhatThisButton | WhatThisHelp | Width | WordWrap | Zoom |
※ 各プロパティの説明は省略しています。
取得方法と書き出し方法を検討
VBAのコード内にひとつづつ書いていくとすごく長くなってしまいます。
そこで、「Control」からプロパティ名を取得できないか調べてみたのですがダメでした。
いろいろ調べところ(Accessではできるようですが)Excel の VBAでは Control のメンバーに プロパティが設定されていないので無理なのです。
そこで仕方なく、あらかじめプロパティー名をシートに書き出しておいて、それを使って取得する方法を検討します。
取得できたデータは一旦配列に代入保持しておき、すべて取得できた後シートに書き出す方法にしたいと思います。
では、設定していきましょう。
UserForm の全プロパティ値を取得するコード
コントロール値を取得する部分は、処理をFunctionモジュールにして分けています。
'UserFormと配置コントロールの全プロパティ値を取得する
Sub getCtrlProperty()
Dim i As Long, ii As Long
Dim a As Long
Dim n As Long: n = 0
Dim r As Long
Dim ufrm As Object
Dim c As Control
Dim fname As String
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("Ctrl_SetValue")
Dim ctrlArry() As String 'Variant
With wb.VBProject
For i = 1 To .VBComponents.Count
If .VBComponents(i).Type = 3 Then 'Type = 3 ユーザーフォーム
n = n + 1
ReDim ctrlArry(39)
fname = .VBComponents.Item(i).Name
ctrlArry(0) = fname
Set ufrm = UserForms.Add(fname)
On Error Resume Next
With ufrm
For a = 1 To 39
ctrlArry(a) = getPVal(ws.Cells(a + 1, 1), ufrm)
Next a
End With
For ii = 0 To UBound(ctrlArry)
ws.Cells(ii + 1, 2) = ctrlArry(ii)
Next ii
On Error GoTo 0
'ここからコントロールのプロパティ取得
ReDim ctrlArry(123) '要素数を変更して初期化
Dim con As Long: con = 0
On Error Resume Next
For Each c In ufrm.Controls
con = con + 1
ctrlArry(0) = TypeName(c)
With c
For a = 1 To 122
ctrlArry(a) = getPVal(ws.Cells(a + 1, 3), c)
Next a
End With
For ii = 0 To UBound(ctrlArry)
ws.Cells(ii + 1, con + 3) = ctrlArry(ii)
Next ii
Next
On Error GoTo 0
Set ufrm = Nothing
End If
Next i
If n = 0 Then MsgBox "UserFormはありません!"
End With
Set ws = Nothing
Set wb = Nothing
End Sub
'指定コントロールの値を取得する
Private Function getPVal(ByVal pName As String, obj As Object) As Variant
Select Case pName
Case "Accelerator": getPVal = obj.Accelerator
Case "Alignment": getPVal = obj.Alignment
Case "AllowColumnReorder": getPVal = obj.AllowColumnReorder
Case "Appearance": getPVal = obj.Appearance
Case "Arrenge": getPVal = obj.Arrenge
Case "AutoSize": getPVal = obj.AutoSize
Case "AutoTab": getPVal = obj.AutoTab
Case "AutoWordSelect": getPVal = obj.AutoWordSelect
Case "BackColor": getPVal = obj.BackColor
Case "BackStyle": getPVal = obj.BackStyle
Case "BorderColor": getPVal = obj.BorderColor
Case "BorderStyle": getPVal = obj.BorderStyle
Case "BoundColumn": getPVal = obj.BoundColumn
Case "Cancel": getPVal = obj.Cancel
Case "Caption": getPVal = obj.Caption
Case "Checkboxes": getPVal = obj.CheckBoxes
Case "ColumnCount": getPVal = obj.ColumnCount
Case "ColumnHeads": getPVal = obj.ColumnHeads
Case "ColumnWidths": getPVal = obj.ColumnWidths
Case "ControlSource": getPVal = obj.ControlSource
Case "ControlTipText": getPVal = obj.ControlTipText
Case "Cycle": getPVal = obj.Cycle
Case "Default": getPVal = obj.Default
Case "Delay": getPVal = obj.Delay
Case "DragBehavior": getPVal = obj.DragBehavior
Case "DrawBuffer": getPVal = obj.DrawBuffer
Case "DropButtonStyle": getPVal = obj.DropButtonStyle
Case "Enabled": getPVal = obj.Enabled
Case "EnterFieldBehavior": getPVal = obj.EnterFieldBehavior
Case "EnterKeyBehavior": getPVal = obj.EnterKeyBehavior
Case "FlatScrollBar": getPVal = obj.FlatScrollBar
Case "Font": getPVal = obj.Font.Name
Case "FontSize": getPVal = obj.Font.Size
Case "FontBold": getPVal = obj.Font.Bold
Case "FontItalic": getPVal = obj.Font.Italic
Case "FontStrikethrough": getPVal = obj.Font.Strikethrough
Case "FontUnderline": getPVal = obj.Font.Underline
Case "ForeColor": getPVal = obj.ForeColor
Case "FullRowSlect": getPVal = obj.FullRowSlect
Case "GridLines": getPVal = obj.Gridlines
Case "GroupName": getPVal = obj.GroupName
Case "Height": getPVal = obj.Height
Case "HelpConTextID": getPVal = obj.HelpContextID
Case "HideColumnHeaders": getPVal = obj.HideColumnHeaders
Case "HideSelection": getPVal = obj.HideSelection
Case "HotTracking": getPVal = obj.HotTracking
Case "HoverSelection": getPVal = obj.HoverSelection
Case "IMEMode": getPVal = obj.IMEMode
Case "IntegralHeight": getPVal = obj.IntegralHeight
Case "KeepScrollbarsVisible": getPVal = obj.KeepScrollBarsVisible
Case "LabelEdit": getPVal = obj.LabelEdit
Case "LabelWrap": getPVal = obj.LabelWrap
Case "LargeChange": getPVal = obj.LargeChange
Case "Left": getPVal = obj.Left
Case "ListRows": getPVal = obj.ListRows
Case "ListStyle": getPVal = obj.ListStyle
Case "ListWidth": getPVal = obj.ListWidth
Case "Locked": getPVal = obj.Locked
Case "MatchEntry": getPVal = obj.MatchEntry
Case "MatchRequired": getPVal = obj.MatchRequired
Case "Max": getPVal = obj.Max
Case "MaxLength": getPVal = obj.MaxLength
Case "Min": getPVal = obj.Min
Case "MouseIcon": getPVal = obj.MouseIcon
Case "MousePointer": getPVal = obj.MousePointer
Case "MultiLine": getPVal = obj.MultiLine
Case "MultiRow": getPVal = obj.MultiRow
Case "MultiSelect": getPVal = obj.MultiSelect
Case "OLEDragMode": getPVal = obj.OLEDragMode
Case "OLEDropMode": getPVal = obj.OLEDropMode
Case "Orientation": getPVal = obj.Orientation
Case "PasswordChar": getPVal = obj.PasswordChar
Case "Picture": getPVal = obj.Picture
Case "pictureAlignment": getPVal = obj.PictureAlignment
Case "PicturePosition": getPVal = obj.PicturePosition
Case "PictureSizeMode": getPVal = obj.PictureSizeMode
Case "PictureTiling": getPVal = obj.PictureTiling
Case "ProportionalThumb": getPVal = obj.ProportionalThumb
Case "RightToLeft": getPVal = obj.RightToLeft
Case "RowSource": getPVal = obj.RowSource
Case "ScrollBars": getPVal = obj.ScrollBars
Case "ScrollHeight": getPVal = obj.ScrollHeight
Case "Scrolling": getPVal = obj.Scrolling
Case "ScrollLeft": getPVal = obj.ScrollLeft
Case "ScrollTop": getPVal = obj.ScrollTop
Case "ScrollWidth": getPVal = obj.ScrollWidth
Case "SelectionMargin": getPVal = obj.SelectionMargin
Case "SelLength": getPVal = obj.SelLength
Case "SelStart": getPVal = obj.SelStart
Case "SelText": getPVal = obj.SelText
Case "ShowDropButtonWhen": getPVal = obj.ShowDropButtonWhen
Case "ShowModal": getPVal = obj.ShowModal
Case "SmallChange": getPVal = obj.SmallChange
Case "Sorted": getPVal = obj.Sorted
Case "SortKey": getPVal = obj.SortKey
Case "SortOder": getPVal = obj.SortOder
Case "SpecialEffect": getPVal = obj.SpecialEffect
Case "StartUpPosition": getPVal = obj.StartUpPosition
Case "Style": getPVal = obj.Style
Case "TabFixedHeight": getPVal = obj.TabFixedHeight
Case "TabFixedWidth": getPVal = obj.TabFixedWidth
Case "TabIndex": getPVal = obj.TabIndex
Case "TabKeyBehavior": getPVal = obj.TabKeyBehavior
Case "TabOrientationTop": getPVal = obj.TabOrientationTop
Case "TabStop": getPVal = obj.TabStop
Case "Tag": getPVal = obj.Tag
Case "TakeFocusOnClick": getPVal = obj.TakeFocusOnClick
Case "Text": getPVal = obj.Text
Case "TextAlign": getPVal = obj.TextAlign
Case "TextBackground": getPVal = obj.TextBackground
Case "TextColumn": getPVal = obj.TextColumn
Case "Top": getPVal = obj.Top
Case "TopIndex": getPVal = obj.TopIndex
Case "TriPleState": getPVal = obj.TripleState
Case "Value": getPVal = obj.Value
Case "View": getPVal = obj.View
Case "Visible": getPVal = obj.Visible
Case "WhatThisButton": getPVal = obj.WhatThisButton
Case "WhatThisHelp": getPVal = obj.WhatThisHelp
Case "Width": getPVal = obj.Width
Case "WordWrap": getPVal = obj.WordWrap
Case "Zoom": getPVal = obj.Zoom
End Select
End Function
動作確認してみました
VBAコード実行後のプロパティデータが書き込まれたシート(一部)が下の画像です。
うまく取得できていますね(^^)
10行目の FontSize のところが金額表示となっていますが(^^;
取得データの入っていないところは、該当するプロパティーが無いか取得出来ない部分です。
まとめ(おわりに)
以上、UserForm とそこに配置している全コントロールの全プロパティー値をVBAで取得する方法の解説でした。
まとめと感想など
コントロールのプロパティー名が取得できればスッキリとしたもっと短いコードになるんですが残念ですね。それでも何とか値を取得できるようになったので、今度はその値をVBAで設定する方法を考えていきましょう。
コントロールの種類によって、プロパティーの種類が全然違うので大変でしたね。結局、全部の種類をあたるようにしたのは仕方ないですね。次にどのように設定するのか楽しみです(^^)
★★★ ブログランキング参加中! クリックしてね(^^)/ ★★★
【今後の記事について】
今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
「汎用でだれでも使えて活用できるように考えてる」というポリシーで、記事を継続して書いていきたいと思っています。どうぞよろしくお願いしますm(_ _)m
【検討中の今後の記事内容は・・・・】
・実務に役立つものを提供できるよう常に検討しています(^^ゞ
・その他雑記的に「プチネタなど」もいろいろ考えていきたいと思っています・・・・
・今後の記事にご期待ください(^^)/
過去記事のサンプルファイルをダウンロードできます
リンク先に今回記事のサンプルファイルを登録しています!
過去の記事で使用したサンプルファイルをダウンロードできるようにページを設置していますので、こちら(このリンク先)からご利用ください
設定したコードでは、自ブックの UserForm の設定を取得することになります。
UserForm が複数あった場合の処理を入れていませんので、取得データは書き込み先に上書きしてしまいます。(2個目以降は別シートに書き込むなどの変更が必要です)
対象を「ブックを指定して取得する」や「開いているブックすべて」などに変更して、自ブック以外の設定を取得するように変更して活用できます。