先日下の質問でご回答いただいたものを参考に新たな表にコマンドボタンを追加しました。
https://teratail.com/questions/288841
先日質問したものと違い、項目と回答が表示される作りになっていたのですが、一番上に、
Private ctrlbtn(1 To 100) As New EventButtonClass
一番下のコマンドボタン追加部位に
Dim Cpybtn As CommandButton Set Cpybtn = .Controls.Add("Forms.CommandButton.1", "copy" & i, True) Call ctrlbtn(i).SetCtrl(Cpybtn)
を追加したところ、問題なく処理されるのですが、フォームがとても小さくなってしまいました。(ステップインで、変数なども問題なく変わっていました。)
フォーム名が「copy」になっていますが、コマンドボタン以外にcopyという名前を設定した覚えがなく、原因がわかりません。
画像の部分はボタンになっておらず、フォーム名が「copy」になっています。
また処理後にエラーではないですが、「オブジェクト変数またはWithブロック変数が設定されていません」とエラーが出ますが何か関係あるのでしょうか?
知識不足なので、的を得ない質問になっているかもい知れませんが、よろしくお願いします。
以下が全体のコードです。
Private ctrlbtn(1 To 100) As New EventButtonClass Sub UserForm_Initialize() Dim Myitem As Object Dim MyPass As Object Dim Cpybtm As Object Dim i As Long Dim Top As Long '項目入力開始位置 Dim row As Long Dim Col As Long Dim item As String row = ActiveCell.row '行番号取得 With UserForm3 Top = 20 '項目開始位置 With .Controls.Add("Forms.Label.1", "タイトル", True) 'タイトル .Top = 10 'Top位置(表示位置を移動する) .Left = 10 'Left位置 .Height = 20 '高さ .Width = 370 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = Cells(row, 3) End With If Cells(row, 5) <> "" Then 'URL有れば With .Controls.Add("Forms.CommandButton.1", "urlb", True) .Top = 34 .Left = 10 .Height = 20 .Width = 50 .Caption = "アクセス" End With With .Controls.Add("Forms.Label.1", "url", True) .Top = 34 'Top位置(表示位置を移動する) .Left = 70 'Left位置 .Height = 20 '高さ .Width = 310 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = Cells(row, 5) End With Top = Top + 24 End If item = "初期値" Col = 5 i = 0 Do While item <> "" Col = Col + 1 item = Cells(row, Col) If item = "" Then Exit Do End If i = i + 1 Set Myitem = .Controls.Add("Forms.Label.1", "MyLabel" & i, True) Set MyPass = .Controls.Add("Forms.Label.1", "MyPass" & i, True) With Myitem 'ここは項目表示 .Top = Top + 24 * i 'Top位置(表示位置を移動する) .Left = 70 'Left位置 .Height = 20 '高さ .Width = 150 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = item End With Col = Col + 1 item = Cells(row, Col) With MyPass 'ここは内容表示 .Top = Top + 24 * i 'Top位置(表示位置を移動する) .Left = 230 'Left位置 .Height = 20 '高さ .Width = 150 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = item End With Dim Cpybtn As CommandButton Set Cpybtn = .Controls.Add("Forms.CommandButton.1", "copy" & i, True) Call ctrlbtn(i).SetCtrl(Cpybtn) With Cpybtn Top = Top + 24 * i Left = 10 Height = 20 Width = 50 Caption = "Copy" End With Loop .Show End With End Sub
クラスのコードはこちらです。(前回質問したものと同じです。)
Private WithEvents tgtCtrl As MSForms.CommandButton Public Sub SetCtrl(new_ctrl As MSForms.CommandButton) Set tgtCtrl = new_ctrl End Sub Private Sub tgtCtrl_Click() MsgBox "コントロール名: " & tgtCtrl.Name End Sub
よろしくお願いします。
Withに点が抜けていませんか。
With Cpybtn
Top = Top + 24 * i
Left = 10
Height = 20
Width = 50
Caption = "Copy"
End With
ご指摘の通りでした・・・すみません・・・。
ちなみに「オブジェクト変数またはWithブロック変数が設定されていません」というエラーが相変わらず最後に表示されるのですが、どんな原因が考えられるでしょうか
基本的には上記と一緒で記入ミスと思います。
F8で行単位でステップして、どの行でエラーが出るか原因が見えてきます。
多分、勘違いによるミスです。iとlを間違えたりという感じですね。
Withを何重にも使っているため、記載ミスが出ているかも知れません。
管理できる階層に制限して使った方が良いです。
私だけの話ですが、基本Withは使った事は無いです。
Set Cpybtn = .Controls.Add・・・・・の様に、
この先はこの名称(Cpybtn)で行くと決めてから書きます。
この名前の付け方が大切で、その人のセンスと勝手に思っています。
VBA全体を通じてしっかりと識別出来て、後々の保守で手掛かりとなる名前を付けます。
使い終わったら、Set Cpybtn = nothingで終了(解放)してOpen~Closeとしてのメリハリを付けます。
古いと言われそうですが、使ったらどこで使い終わったかを確実に行うことを心掛けてています。
----------------------------------------------------
確実では無いですがエラー処理を入れるのも良いかと思います。
下記の様な感じで処理を入れると、エラー発生時に末尾へ飛びます。
最後に表示・・・と言われていますので、取れない可能性もあります。
’
Public Function test(・・・・
On Error GoTo Err_処理
・
・
Exit Function
'(正常終了)
Err_処理:
MsgBox "Error=" & Err.Number & " " & Err.Description
'(異常終了)
End Function
アドバイスありがとうございます。定義にメリハリをつけ、慣れるまでwithの多用は避けようと思います。
エラーの表示ですが、フォームを閉じた後にEnd subが終わった後に出てきます。
ネットの情報だと「set」の付け忘れで起こるそうなんですが、「set」を付けるのはobujectに対してだけでしょうか。
ステップインで確認した限りだと、obuject定義した3つはNothingになっていないので、原因はobuject=Nothingではないとは思うのですが・・・。
Set object=Nothingの付け忘れで出ることはあまりありません。
プログラムが大きくなった場合や、複数Bookを起する処理の場合に動作が変になることがあります。その原因としてオブジェクトが残る問題があって、使ったObjectは習慣としてNothingで終わる様に入れるだけです。
問題なく動いているのであれば、入れなくとも構わないと思います。
※.追記:回答出ている様です。
回答1件
あなたの回答
tips
プレビュー