| |
↓を参考にアクティブブックのユーザーフォームのコントロールの
情報をセルに転記するコードを書いてみました。
tp://www.vbalab.net/vbaqa/data/excel/log/tree_124.htm
---------------
Sub UF()
'違うブックの場合はUserForm1と指定できないので、VBComponent(s)を使います。
'VBComponent.Type = 3 というのはこのコンポーネントが
'ユーザーフォームという意味です。
Dim vbcs As Object, vbc As Object, ctl As Object
Dim wb As Workbook, ws As Worksheet
Dim newwb As Workbook
Dim newwbmei As String
Dim RR&
Dim flg As Boolean
'
Set wb = ActiveWorkbook 'チェックの対象は現在表示しているブックです。
Set vbcs = wb.VBProject.VBComponents
Set ws = ThisWorkbook.Worksheets(1)
ws.Columns.ColumnWidth = 15
'表題いろいろ
RR& = 1
ws.Cells(RR&, 1).Value = "ブック名"
ws.Cells(RR&, 2).Value = wb.Name
RR& = RR& + 1
ws.Cells(RR&, 1).Value = "コントロール"
ws.Cells(RR&, 2).Value = "Caption"
ws.Cells(RR&, 3).Value = "親（所属）"
ws.Cells(RR&, 4).Value = "フォーム名"
ws.Cells(RR&, 5).Value = "Left"
ws.Cells(RR&, 6).Value = "Top"
ws.Cells(RR&, 7).Value = "Width"
ws.Cells(RR&, 8).Value = "Height"
ws.Cells(RR&, 9).Value = "ForeColor"
ws.Cells(RR&, 10).Value = "BackColor"
ws.Cells(RR&, 11).Value = "Font"
ws.Cells(RR&, 12).Value = "Font.Size"
flg = False
On Error Resume Next
For Each vbc In vbcs '☆
If vbc.Type = 3 Then
flg = True
vbc.DesignerWindow.Visible = True
For Each ctl In vbc.Designer.Controls
RR& = RR& + 1
ws.Cells(RR&, 1).Value = ctl.Name
ws.Cells(RR&, 2).Value = ctl.Caption
ws.Cells(RR&, 3).Value = ctl.Parent.Name
ws.Cells(RR&, 4).Value = vbc.Name
ws.Cells(RR&, 5).Value = ctl.Left
ws.Cells(RR&, 6).Value = ctl.Top
ws.Cells(RR&, 7).Value = ctl.Width
ws.Cells(RR&, 8).Value = ctl.Height
ws.Cells(RR&, 9).Value = ctl.ForeColor
ws.Cells(RR&, 10).Value = ctl.BackColor
ws.Cells(RR&, 11).Value = ctl.Font
ws.Cells(RR&, 12).Value = ctl.Font.Size
Next
vbc.DesignerWindow.Visible = False
End If
Next
On Error GoTo 0
If flg = False Then
MsgBox wb.Name & " にはユーザーフォームがありません。"
End If
newwbmei = ws.Cells(1, 2).Value
newwbmei = Left(newwbmei, Len(newwbmei) - 4)
newwbmei = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
& "\" & Format(Now, "yymmdd_hhmmss") & "(" & newwbmei & ")UFProperty.xls"
ws.Copy
Set newwb = ActiveWorkbook
newwb.SaveAs newwbmei
newwb.Close
Set newwb = Nothing
ws.Parent.Saved = True
Set ws = Nothing: Set wb = Nothing
Set vbcs = Nothing
End Sub
------------
このコードに加えて、コントロールの種類(TextBox,ListBox等々)も取得したいと考えています。
コントロールの種類を取得するにはどのように記述すればいいでしょうか？
ご教示お願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
