ユーザーフォームをWorkSheet(1)に固定
●質問の主旨
WorkSheet(1)(「柴田8月分」)にユーザーフォームを固定的に
表示させつつ、WorkSheet(1)以降のWorkSheet(2)、
WorkSheet(3)、WorkSheet(4)の表を参照しながら
ComboBox1、ComboBox2、ComboBox3にリストを
選択して、データベースに入力したいと考えています。
以下のコードをどのように書き換えれば良いでしょうか?
ご教示のほどよろしくお願い申し上げます。
●質問の補足
現在のコードでは、ComboBox1、ComboBox2、ComboBox3を
それぞれ選択しているとユーザーフォームがそれぞれ
WorkSheet(2)、WorkSheet(1)(顧客リスト)、WorkSheet(3)(社員名)、
WorkSheet(4)(大分類)にとんでしまいます。
転記入力が終了すると、また手作業でWorkSheet(1)に戻らなければなりません。
その手作業を回避したいと考えています。
なお添付画像はComboBox1の選択前なのでWorkSheet(1)
に留まってくれています。
●コード
Option Explicit
'ユーザーフォームの初期化
Private Sub UserForm_Initialize()
Dim r As Range
Dim n As Range
Dim d As Range
With Worksheets(2)
Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = ";0"
.List = r.Value
End With
With Worksheets(3)
Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = ";0"
.List = n.Value
End With
With Worksheets(4)
Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox3
.ColumnCount = 2
.ColumnWidths = ";0"
.List = d.Value
End With
Set r = Nothing
Set n = Nothing
Set d = Nothing
TextBox3.Value = Worksheets(1).Range("A2").Value + 1
txtdate = Date
OptionButton1.Value = True
End Sub
'ComboBox1をクリックしたときの処理
Private Sub ComboBox1_Click()
Worksheets(2).Select
With Me.ComboBox1
Me.Label19.Caption = .List(.ListIndex, 1)
Worksheets(2).Select Replace:=False
End With
End Sub
'ComboBox2をクリックしたときの処理
Private Sub ComboBox2_Click()
Worksheets(3).Select
With Me.ComboBox2
Me.Label20.Caption = .List(.ListIndex, 1)
Worksheets(3).Select Replace:=False
End With
End Sub
'フォームからデータベースへの転記
Private Sub CommandButton3_Click()
Dim Rowpos As Long
Dim ColPos As Long
Rowpos = Worksheets("柴田8月分").Range("a10000").End(xlUp).Row
ColPos = 1
Rowpos = Rowpos + 1
With Worksheets("柴田8月分")
.Cells(Rowpos, ColPos) = TextBox3.Value
.Cells(Rowpos, ColPos + 1) = txtdate.Value
.Cells(Rowpos, ColPos + 2) = Label19.Caption
.Cells(Rowpos, ColPos + 3) = ComboBox1.Text
.Cells(Rowpos, ColPos + 4) = ComboBox2.Text
.Cells(Rowpos, ColPos + 5) = Label20.Caption
.Cells(Rowpos, ColPos + 6) = ComboBox3.Text
End With
'Noの加算
Dim i As Long
For i = 1 To 1 Step 1
TextBox3.Value = TextBox3.Value + 1
Next
Call Clearcmb
End Sub
'データベース入力後にコンボボックスを空欄にする
Private Sub Clearcmb()
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
End Sub
'ユーザーフォームの終了
Private Sub CommandButton5_Click()
Unload UserForm1
End
End Sub
以上よろしくお願い申し上げます。使用機種はWindowsVistaで、
Excel2007です。私はVBA初心者です。
お礼
ありがとうございました