Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

23600 / 76732

←次へ　｜　前へ→


	【58498】ユーザーフォームのコントロールの種類を取得する

pantyo - 08/10/28(火) 14:49 -


	引用なし

	パスワード

↓を参考にアクティブブックのユーザーフォームのコントロールの
情報をセルに転記するコードを書いてみました。

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等々)も取得したいと考えています。
コントロールの種類を取得するにはどのように記述すればいいでしょうか？
ご教示お願いいたします。

0 hits

▼

【58498】ユーザーフォームのコントロールの種類を取得する pantyo 08/10/28(火) 14:49

≪