C# と VB.NET の質問掲示板

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

VBAでオブジェクト操作


(過去ログ 19 を表示中)

[トピック内 1 記事 (1 - 1 表示)]  << 0 >>

■7735 / inTopicNo.1)  VBAでオブジェクト操作
  
□投稿者/ Dragon (1回)-(2007/09/13(Thu) 20:19:28)

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

引用返信 編集キー/


トピック内ページ移動 / << 0 >>

このトピックに書きこむ

過去ログには書き込み不可

管理者用

- Child Tree -