プロが教えるわが家の防犯対策術!

とあるブックを改訂するのですが、シート内に機能が異なるフォームコントロールが百以上あり、それを分析して正しい計算式に直したり、不要なものは削除します。その作業に伴い体裁も整えなければなりません。そのブックも数百あります。

質問です。
・ブック内に設定されているフォームコントロールの一覧を表示できますか。
・一覧が表示できたとして、そこには設定内容(チェックボックスのセル参照先、ラジオボタンを選択したら設定先のセルに数字が入るなど)は表示されていますか。
・この改訂作業を効率よく行う方法はありますか。

チェックボックスなどを一個一個手作業で確認していくのに疲れました。。。

A 回答 (1件)

こんばんは


VBAを使う方法になると思います
VBAの基礎知識が無い場合または、VBAを実行出来ない環境でしたら
以下は無視してください

・ブック内に設定され・・・
・一覧が表示できたとして、そこには・・・
いかにVBAを書きます(フォームコントロール用です)

新しいブックに標準モジュールを追加して下記コード全てをコピペし
Test01を実行します
ブックを選ぶダイアログが表示されますので対象のブックを選んで実行してください
(注意:対象ブックはコピーブックなどで試してください)

新しく作ったブックも出来れば事前に任意の場所、任意の名前で保存してください

シート名 オブジェクトの名前 場所 タイプ アクションなどの 一覧が コードをコピペした新しいブックの一番左にあるシートに書き出されます
テストなので制御系の命令は入れていません

・この改訂作業を効率よく行う方法はありますか。

改造し易いようにコード内にタイプ別の処理がありますので 
条件を設けて(どのように現状を判断しているかを考察し条件とする)
そこでオブジェクトのプロパティなどを設定、削除などすれば・・できるかな?

Dim colm As Long
Dim TrgBook As Workbook
Dim MyBook As Workbook
Sub Test01()
Dim TrgPath As String
Set MyBook = ActiveWorkbook
TrgPath = Application.GetOpenFilename("Excel ブック,*.xls?")
If TrgPath = "False" Then Exit Sub
Set TrgBook = Workbooks.Open(TrgPath)
Dim sht As Worksheet
colm = 2
For Each sht In TrgBook.Worksheets
Call Sample01(sht)
colm = colm + 6
Next
TrgBook.Close SaveChanges:=False
End Sub

Sub Sample01(sht As Worksheet)
Dim shp As Shape
Dim arr(), n As Long
MyBook.Sheets(1).Cells(1, colm - 1).Resize(, 4) _
= Array(sht.Name, "ObjectName", "ObjectAddress", "ObjectType", "ObjectAction/Text")
For Each shp In sht.Shapes
With shp
If .Type = 8 Then
ReDim Preserve arr(3, n)
arr(0, n) = .Name
arr(1, n) = .TopLeftCell.Address
Select Case .FormControlType
Case 0
arr(2, n) = "ボタン"
arr(3, n) = .OnAction
Case 1: arr(2, n) = "チェック ボックス"
Case 2: arr(2, n) = "コンボ ボックス"
Case 3: arr(2, n) = "テキスト ボックス"
Case 4: arr(2, n) = "グループ ボックス"
Case 5
arr(2, n) = "ラベル"
arr(3, n) = .TextFrame.Characters.Text
Case 6: arr(2, n) = "リスト ボックス"
Case 7: arr(2, n) = "オプション ボタン"
Case 8: arr(2, n) = "スクロール バー"
Case 9: arr(2, n) = "スピン ボタン"
End Select
n = n + 1
End If
End With
Next
MyBook.Sheets(1).Cells(2, colm).Resize(UBound(arr, 2) + 1, UBound(arr, 1) + 1).Value _
= WorksheetFunction.Transpose(arr)
End Sub
    • good
    • 2
この回答へのお礼

拙い質問に丁寧なご回答とご提案をいただきありがとうございます。
早速ご提案のコードを利用させていただきます。
これで一日の業務のクリック数が大げさでなく数千は減ると思いますし、
安全で確実に文書を改定できると思います。

本当にありがとうございます。

お礼日時:2022/12/28 07:30

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!