|
分類:[Microsoft Office 全般]
環境 Excel 2007, WinXP
開発言語 VBA
こんにちは。VBAでオブジェクトの扱いを勉強しています。
標準モジュールに添付のコードを適用しています。
もっとスマートなやり方がありましたら、ご教授下さい。 よろしくお願い致します。
また、懸念事項などもございましたら、ご指摘いただけるとありがたいです。
''' ---------------------------------------------------------------------------------------
''' <summary>
''' Excel のコマンドバー名、コマンドバーオブジェクト内のコントロール、サブコントロール
''' とそのコントロール ID すべてを、Excelドキュメントに出力します。
''' </summary>
''' ---------------------------------------------------------------------------------------
Sub ListCommandBarControls()
Dim rowCount As Integer
rowCount = 1
'Header Definition
setHeader
For Each cb In Application.CommandBars
rowCount = rowCount + 1
'CommandBar
Range("A" & rowCount).Select
ActiveCell.FormulaR1C1 = cb.Name
'コマンドバーオブジェクト内のコントロールを収集
For Each cntl In Application.CommandBars(cb.Name).Controls
rowCount = rowCount + 1
'Caption
Range("B" & rowCount).Select
ActiveCell.FormulaR1C1 = cntl.Caption
'Error Capturing
On Error GoTo ErrHandler:
'コマンドバーオブジェクト内のコントロール内のサブコントロールを収集
For Each subcntl In Application.CommandBars(cb.Name).Controls(cntl.Caption).Controls
rowCount = rowCount + 1
'サブコントロールのCaption
Range("C" & rowCount).Select
ActiveCell.FormulaR1C1 = subcntl.Caption
'ID
Range("D" & rowCount).Select
ActiveCell.FormulaR1C1 = subcntl.ID
Next
PastError:
Next
Next
GoTo bypass:
'エラー処理を実施
ErrHandler:
Range("C" & rowCount).Select
ActiveCell.FormulaR1C1 = cntl.ID
Resume PastError:
bypass:
End Sub
''' ---------------------------------------------------------------------------------------
''' <summary>
''' 出力ファイルのヘッダを定義します。
''' </summary>
''' ---------------------------------------------------------------------------------------
Private Sub setHeader()
Const CombarColWidth = 18
Const CaptionColWidth = 21
Const LocalCaptionColWidth = 23
Const ControlIdColWidth = 15
Const defaultColor = 35
Columns("A:A").ColumnWidth = CombarColWidth
Columns("B:B").ColumnWidth = CaptionColWidth
Columns("C:C").ColumnWidth = LocalCaptionColWidth
Columns("D:D").ColumnWidth = ControlIdColWidth
Range("A1").Select
ActiveCell.FormulaR1C1 = "Command Bar"
ActiveCell.Interior.ColorIndex = defaultColor
ActiveCell.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "Control Caption"
ActiveCell.Interior.ColorIndex = defaultColor
ActiveCell.Font.Bold = True
Range("C1").Select
ActiveCell.FormulaR1C1 = "Local Caption"
ActiveCell.Interior.ColorIndex = defaultColor
ActiveCell.Font.Bold = True
Range("D1").Select
ActiveCell.FormulaR1C1 = "Control ID"
ActiveCell.Interior.ColorIndex = defaultColor
ActiveCell.Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
End Sub
|