| |
シートの該当行のデータをフォーム上のテキストボックスに収集し、そこで変更が必要なデータは修正し、別の印刷用のシートにデータを転記し印刷するファイルを作成しています。
フォーム上の一部のテキストボックスを複数列のコンボボックスに変更してデータの修正を容易にしようと思います。
別ファイルで単独の複数列のコンボボックスへのデータ収集・リスト表示はうまくいったんですが、そのコードを作成中のファイルに書き込むと、うまくコンボボックスへデータの収集・リスト表示ができません。
なぜ、うまくいかないかわかりません。
ご指導をお願いします。コードは下記の通りです。
Private Sub CommandButton1_Click()
'入力フォームを開く
UserForm1.Show
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'A列セル選択右クリックでセルデータ収集後フォームを開く
Dim r As Range
Dim i As Single
If Target.Column <> 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
Cancel = True
UserForm1.Show 0
i = 1
For Each r In Target.Offset(, 1).Resize(, 6)
UserForm1.Controls("TextBox" & i).Text = r.Value
i = i + 1
Next r
End Sub
Private Sub TextBox7_AfterUpdate()
'行番号入力でセルデータ収集
Dim t7 As Long
Dim i As Long
t7 = Me.TextBox7.Text
i = 1
For i = 1 To 6
Me.Controls("textbox" & i).Text = ActiveSheet.Cells(t7, i + 1).Value
Next i
ActiveSheet.Cells(t7, 1).Select
TextBox7.SetFocus
End Sub
Private Sub CommandButton2_Click()
'フォームデータをシートの最終データセルの下のセルに転記と別シート印刷
Worksheets("sheet3").Activate
With Range("B5").End(xlDown)
.Offset(1, 0).Value = TextBox1.Value
.Offset(1, 1).Value = Now
.Offset(1, 2).Value = TextBox3.Value
.Offset(1, 3).Value = TextBox4.Value
.Offset(1, 4).Value = TextBox5.Value
.Offset(1, 5).Value = TextBox6.Value
End With
With Worksheets("Sheet4")
.Cells(16, 2).Value = TextBox1.Text
.Cells(2, 3).Value = Now
.Cells(5, 2).Value = TextBox3.Text
.Cells(5, 4).Value = TextBox4.Text
.Cells(5, 7).Value = TextBox5.Text
.Cells(5, 5).Value = TextBox6.Text
End With
Worksheets("Sheet4").PrintOut
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
UserForm1.Hide
End Sub
'-----------------------------------------------------
Private Sub UserForm1_Initialize()
'コンボボックスへのセルデータ転記
Dim lRow As Long, myData(2, 2) As Variant
With Worksheets("Sheet1")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
With ComboBox1
.ColumnCount = 2
.ColumnWidths = "60"
.RowSource = "Sheet1!A1:B" & lRow
End With
End Sub
'-----------------------------------------------------
追加したコードはこの上です。
|
|
おじさん４６
- 08/6/9(月) 20:21 -
