Excel VBA質問箱 IV

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

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


5353 / 13644 ツリー ←次へ | 前へ→

【51331】ユーザーフォームのコントロールソースの一覧 BLUELION 07/9/12(水) 13:50 質問[未読]
【51334】Re:ユーザーフォームのコントロールソース... Jaka 07/9/12(水) 14:25 発言[未読]
【51336】Re:ユーザーフォームのコントロールソース... BLUELION 07/9/12(水) 15:49 お礼[未読]
【51339】Re:ユーザーフォームのコントロールソース... Jaka 07/9/12(水) 16:41 発言[未読]
【51340】Re:ユーザーフォームのコントロールソース... BLUELION 07/9/12(水) 16:43 お礼[未読]
【51358】Re:ユーザーフォームのコントロールソース... Jaka 07/9/13(木) 9:17 発言[未読]
【51360】Re:ユーザーフォームのコントロールソース... BLUELION 07/9/13(木) 9:29 お礼[未読]

【51331】ユーザーフォームのコントロールソースの...
質問  BLUELION  - 07/9/12(水) 13:50 -

引用なし
パスワード
   業者に発注してEXCEL2000で作成してもらった
システムがあるのですが 最近のEXCELはOSでは動作しないPCが
出てきたためにACCESSへ移行しようとしていますが
担当が退職し受けてもらえず自分たちで移行することになりました


そこで ユーザーフォームに存在する コントロールの
Controlsourceをテキストファイルに出力しデータの結びつきを整理
したいのですがコントロールやフォームの指定をどうすればいいかわからず
うまくいきませんでした

結局 エクセルのユーザーフォームをエクスポートして
VB2005で開いて
以下のようにしてうまくいきましたが
今後のためにも エクセルVBAで同じことをする方法をおしえてください

===============VB2005===============
Private Sub UserForm_Initialize()
  
  Dim lLen    As Long
  
  lLen = FreeFile
  
  Open "D:\AAAAA.TXT" For Output As #lLen
  
  For Each Control In frmユーザーフォーム名.Controls
   
    If UCase(CStr(TypeName(Control))) = "TEXTBOX"
    Or UCase(CStr(TypeName(Control))) = "COMBOBOX" Then
      If Control.controlsource <> "" Then
        Print #lLen, Control.Name & "," & Control.controlsource
      End If
    End If

  Next

  Close #lLen
  
  End
  
End Sub

【51334】Re:ユーザーフォームのコントロールソー...
発言  Jaka  - 07/9/12(水) 14:25 -

引用なし
パスワード
   質問内容とはちょっと違いますけど。
応用が利くかと思います
5年ぐらい前に別のところで回答したまんまで、すみません。

標準モジュールで使用。

Sub kame()
  Dim VBC As Object
  Range("A1").Value = "コントロール名"
  Range("B1").Value = "コントロール種類"
  Range("C1").Value = "キャプション "
  With ThisWorkbook.VBProject
    For Each VBC In .VBComponents
      If VBC.Type = 3 Then
        G = G + 2
        Cells(G, 1).Value = VBC.Name
        Set AdUF = VBA.UserForms.Add(VBC.Name)
        For Each FCN In AdUF.Controls
          G = G + 1
          Cells(G, 1).Value = FCN.Name
          Cells(G, 2).Value = TypeName(FCN)
          On Error Resume Next
          Cells(G, 3).Value = FCN.Caption
          On Error GoTo 0
        Next
      End If
    Next
  End With
  Set AddUF = Nothing
End Sub

【51336】Re:ユーザーフォームのコントロールソー...
お礼  BLUELION  - 07/9/12(水) 15:49 -

引用なし
パスワード
         Jaka さま

無事以下のようなコードで解決できました
本当にありがとうございます

ただ私ではループしたなかで必要コンポーネントのみ処理する形しかできませんでしたが
必要なものを直接指定で処理する方法をおしえていただけませんか?

よろしくお願いいたします


Sub kame()
  Dim VBC As Object
  Range("A1").Value = "コンポーネント名"
  Range("B1").Value = "コントロール名"
  Range("C1").Value = "コントロール種類 "
  Range("d1").Value = "ControlSource "
  Range("e1").Value = "Caption "

  With ThisWorkbook.VBProject
    For Each VBC In .VBComponents
      If VBC.Name = "必要なコンポーネント名で今回はFORM名" Then
        g = g + 2
        Cells(g, 1).Value = VBC.Name
        Set AdUF = VBA.UserForms.Add(VBC.Name)
        For Each fcn In AdUF.Controls
            g = g + 1
            Cells(g, 1).Value = VBC.Name
            Cells(g, 2).Value = fcn.Name
            Cells(g, 3).Value = TypeName(fcn)
            
            On Error Resume Next
            Cells(g, 4).Value = fcn.ControlSource
            Cells(g, 5).Value = fcn.Caption
            On Error GoTo 0
        Next
      End If
    Next
  End With
  Set AddUF = Nothing
End Sub

【51339】Re:ユーザーフォームのコントロールソー...
発言  Jaka  - 07/9/12(水) 16:41 -

引用なし
パスワード
   複数のフォーム全てでなく1個だけだったら、
直接指定してやれば良いです。

Set AdUF = VBA.UserForms.Add("必要なコンポーネント名で今回はFORM名")

【51340】Re:ユーザーフォームのコントロールソー...
お礼  BLUELION  - 07/9/12(水) 16:43 -

引用なし
パスワード
   重ね重ねありがとうございます

エクセルというかVBAはほぼはじめてなので
ルールがわからずに困っています

【51358】Re:ユーザーフォームのコントロールソー...
発言  Jaka  - 07/9/13(木) 9:17 -

引用なし
パスワード
   1個だけ指定するんだったら、これだけで良いかも。

Load Form1 '←無くても可。
On Error Resume Next
For Each Obj In Form1.Controls
  i = i + 1
  Cells(i, 1).Value = Obj.Name
  Cells(i, 2).Value = Obj.Caption
Next
Unload Form1

【51360】Re:ユーザーフォームのコントロールソー...
お礼  BLUELION  - 07/9/13(木) 9:29 -

引用なし
パスワード
   再度ためしてみます

ありがとうございます

5353 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free