|  | 分類:[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
 |