teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

2

コード微修正

2020/09/01 06:33

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -15,14 +15,14 @@
15
15
  Private myLabel As MSForms.Label
16
16
 
17
17
  Private Sub myCmdBtn_Click()
18
+ If myLabel.Caption = "" Then Exit Sub
18
19
 
19
20
  With New MSForms.DataObject
20
21
  .SetText myLabel.Caption 'ラベルのCaptionをDataObjectに格納する
21
22
  .PutInClipboard 'DataObjectのデータをクリップボードに格納する
22
23
  End With
23
-
24
+
24
25
  MsgBox "URLをクリップボードにコピーしました。"
25
-
26
26
  End Sub
27
27
 
28
28
  Public Sub setBtnLbl(Cmdbtn As MSForms.CommandButton, lbl As MSForms.Label)
@@ -34,14 +34,13 @@
34
34
  **UserForm2 モジュール**
35
35
  ```vba
36
36
  Option Explicit
37
+
37
38
  Dim myCol As Collection
38
39
  Dim myBtnLbl As CmdBtnWithLabel
39
40
 
40
-
41
41
  Sub UserForm_Initialize()
42
42
  Set myCol = New Collection
43
43
 
44
-
45
44
  Dim row As Long
46
45
  row = ActiveCell.row '行番号取得
47
46
 

1

サンプルコード追記

2020/09/01 06:33

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -2,4 +2,85 @@
2
2
 
3
3
  「VBA クラスモジュール イベント 共通化」で検索するとサンプルコードはいろいろ見つかります。
4
4
 
5
- [VBA クラスモジュール イベント共通 \- Google 検索](https://www.google.com/search?q=VBA+%E3%82%AF%E3%83%A9%E3%82%B9%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB+%E3%82%A4%E3%83%99%E3%83%B3%E3%83%88%E5%85%B1%E9%80%9A&oq=VBA+%E3%82%AF%E3%83%A9%E3%82%B9%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB+%E3%82%A4%E3%83%99%E3%83%B3%E3%83%88%E5%85%B1%E9%80%9A)
5
+ [VBA クラスモジュール イベント共通 - Google 検索](https://www.google.com/search?q=VBA+%E3%82%AF%E3%83%A9%E3%82%B9%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB+%E3%82%A4%E3%83%99%E3%83%B3%E3%83%88%E5%85%B1%E9%80%9A&oq=VBA+%E3%82%AF%E3%83%A9%E3%82%B9%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB+%E3%82%A4%E3%83%99%E3%83%B3%E3%83%88%E5%85%B1%E9%80%9A)
6
+
7
+ ---
8
+ この質問の場合、コマンドボタンとラベルがワンセットなので、クラスモジュールもその2つをセットにしたものにするといいでしょう。
9
+
10
+ **クラスモジュール CmdBtnWithLabel**
11
+ ```vba
12
+ Option Explicit
13
+
14
+ Private WithEvents myCmdBtn As MSForms.CommandButton
15
+ Private myLabel As MSForms.Label
16
+
17
+ Private Sub myCmdBtn_Click()
18
+
19
+ With New MSForms.DataObject
20
+ .SetText myLabel.Caption 'ラベルのCaptionをDataObjectに格納する
21
+ .PutInClipboard 'DataObjectのデータをクリップボードに格納する
22
+ End With
23
+
24
+ MsgBox "URLをクリップボードにコピーしました。"
25
+
26
+ End Sub
27
+
28
+ Public Sub setBtnLbl(Cmdbtn As MSForms.CommandButton, lbl As MSForms.Label)
29
+ Set myCmdBtn = Cmdbtn
30
+ Set myLabel = lbl
31
+ End Sub
32
+ ```
33
+
34
+ **UserForm2 モジュール**
35
+ ```vba
36
+ Option Explicit
37
+ Dim myCol As Collection
38
+ Dim myBtnLbl As CmdBtnWithLabel
39
+
40
+
41
+ Sub UserForm_Initialize()
42
+ Set myCol = New Collection
43
+
44
+
45
+ Dim row As Long
46
+ row = ActiveCell.row '行番号取得
47
+
48
+ With Me
49
+ Dim n As Long
50
+ For n = 1 To 5
51
+ Dim lbl As MSForms.Label
52
+ Set lbl = .Controls.Add("Forms.Label.1", "url" & n, True)
53
+ With lbl
54
+ .Top = 34 * n 'Top位置(表示位置を移動する)
55
+ .Left = 70 'Left位置
56
+ .Height = 20 '高さ
57
+ .Width = 250 '幅
58
+ .BorderStyle = fmBorderStyleSingle '枠線
59
+ .BackColor = RGB(128, 128, 128) '背景色
60
+ .ForeColor = RGB(255, 255, 255) '文字色
61
+ .Font.Name = "メイリオ" 'テキストのスタイル
62
+ .TextAlign = 2 'テキストの位置
63
+ .FontSize = 16 'テキストのサイズ
64
+ .Caption = Cells(row, 5) '''ここにパスワードの題名を付ける
65
+ End With
66
+
67
+ Dim btn As MSForms.CommandButton
68
+ Set btn = .Controls.Add("Forms.CommandButton.1", "url" & n, True)
69
+ With btn
70
+ .Top = 34 * n
71
+ .Left = 10
72
+ .Height = 20
73
+ .Width = 50
74
+ .Caption = "copy"
75
+ End With
76
+
77
+ Set myBtnLbl = New CmdBtnWithLabel
78
+ myBtnLbl.setBtnLbl btn, lbl
79
+ myCol.Add myBtnLbl
80
+
81
+ row = row + 1
82
+ Next
83
+
84
+ End With
85
+ End Sub
86
+ ```