Top> 部品（フォーム）
フォームの表示
kamoku.Show
フォームを閉じる
Unload Me
テキストボックスの変化での取り込み
Private Sub txtiroiro_Change()
lbltexttorikomi.Caption = txtiroiro.Text
End Sub
テキストボックスのエンターの取り込み
Private Sub txtiroiro_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
lbltexttorikomi.Caption = txtiroiro.Text
End If
End Sub
エンター入力（Vlookup関数の例）
Dim lngTcode As Long
Dim strName As String
Dim strAdd1 As String
Dim strAdd2 As String
Dim hani As Range
Set hani = Worksheets("得意先").Range("A2:D" & lastRow)
If KeyCode = 13 Then
lngTcode = txtTcode.Text
strName = Application.WorksheetFunction.VLookup(lngTcode, hani, 2)
strAdd1 = Application.WorksheetFunction.VLookup(lngTcode, hani, 3)
strAdd2 = Application.WorksheetFunction.VLookup(lngTcode, hani, 4)
txtName.Text = strName
txtAdd1.Text = strAdd1
txtAdd2.Text = strAdd2
If strName = "" Then
MsgBox "得意先コードはありません"
lngTcode = 0
txtTcode.Text = ""
strName = ""
strAdd1 = ""
strAdd2 = ""
txtName.Text = strName
txtAdd1.Text = strAdd1
txtAdd2.Text = strAdd2
End If
End If
エンター入力（ForNextステートメントの例）
Dim lngTcode As Long
Dim i As Long
Dim lastRow As Long
Dim strName As String
Dim strAdd1 As String
Dim strAdd2 As String
lastRow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
If KeyCode = 13 Then
lngTcode = txtTcode.Text
For i = 2 To lastRow
If Worksheets("得意先").Cells(i, 1) = lngTcode Then
strName = Worksheets("得意先").Cells(i, 2)
strAdd1 = Worksheets("得意先").Cells(i, 3)
strAdd2 = Worksheets("得意先").Cells(i, 4)
txtName.Text = strName
txtAdd1.Text = strAdd1
txtAdd2.Text = strAdd2
Exit For
End If
Next
If strName = "" Then
MsgBox "得意先コードはありません"
lngTcode = 0
txtTcode.Text = ""
strName = ""
strAdd1 = ""
strAdd2 = ""
txtName.Text = strName
txtAdd1.Text = strAdd1
txtAdd2.Text = strAdd2
End If
End If
エンター入力（FIND検索で行取得の例）
Dim strTokuiCd As String
Dim strTokuiNm As String
Dim gyou As Integer
Select Case KeyCode
Case vbKeyReturn
Worksheets("得意先").Activate
gyou = Range("A2:A9").Find(txttcode.Text)
strTokuiNm = Cells(gyou + 1, 2).Value
strTokuiCd = txttcode.Text
Case Else
Exit Sub
End Select
lbltokuiname.Caption = strTokuiNm
テキストボックスの取り込み
lbltexttorikomi.Caption = txtiroiro.Text
フォームがロード（立ち上がる）時の処理
Private Sub UserForm_Initialize()
End Sub
リストボックスにデータを登録（直接）
With lstiroiro1
.AddItem "a"
.AddItem "b"
.AddItem "c"
.AddItem "d"
.AddItem "e"
End With
リストボックスにデータの表示（RowSourceを使った場合）
Dim lastRow As Long
lastRow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
With lstTokui
.ColumnCount = 4
.ColumnWidths = "50;50;50;50"
.RowSource = "得意先!A1:D" & lastRow
End With
リストボックスにデータの表示（For Nextステートメントの例）
Dim i As Long
Dim lastRow As Long
lastRow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
lstTokui.AddItem Worksheets("得意先").Cells(i, 2)
Next
リストボックスにデータの表示複数列（ForNextステートメントの例）
lastRow = Worksheets("科目表").Cells(Rows.Count, 1).End(xlUp).Row
kamokulist.ColumnCount = 2
For i = 2 To lastRow
With kamokulist
.AddItem
.List(i - 2, 0) = Worksheets("科目表").Cells(i, 1)
.List(i - 2, 1) = Worksheets("科目表").Cells(i, 2)
End With
Next
スペース検索でリストボックスを表示し該当するデータを選択する
Private Sub txtkamoku_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)Select Case KeyCode
Case vbKeySpace
kamokuf.Show
Case Else
Exit Sub
End Select
End Sub
スペース検索でリストボックスを表示し該当するデータを選択する（コード番号）
Dim intShowStatus As Integer
Dim strTokuiCd As String
Dim strTokuiNm As String
Select Case KeyCode
Case vbKeySpace
intShowStatus = frmtokuikensaku.PlbshowDialog(strTokuiCd, strTokuiNm)
If intShowStatus <> 0 Then Exit Sub
Case Else
Exit Sub
End Select
txttcode.Text = strTokuiCd
lbltokuiname.Caption = strTokuiNm
リストボックスのデータの取り出し
maker = lstMaker.Text
リストボックスにデータのクリックでの取り出し
Private Sub lstiroiro1_Click()
lbllist1torikomi.Caption = lstiroiro1.Text
txtlist1torikomi.Text = lstiroiro1.Text
End Sub
リストボックスのデータをダブルクリックで取り込む
Private Sub lstiroiro1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
lbllist1torikomi.Caption = lstiroiro1.Text
txtlist1torikomi.Text = lstiroiro1.Text
End Sub
Private Sub kamokulist_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell = kamokulist.Text
Unload Me
End Sub
Private Sub lstriyousya_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
kaigokeikau.txtrcode.Text = lstriyousya.Text
With Worksheets("名簿").Range("C3")
.AutoFilter 'オートフィルタのクリア
End With
Unload Me
Unload riyousyakensaku
End Sub
リストボックスのデータをOKボタンクリックで取り込む
Private Sub cmdok_Click()
kaigokeikau.txtrcode.Text = lstmeisai.Text
Unload Me
Unload kaiketumidashi
End Sub
抽出したデータをリストボックスに取り込む
Dim i As Long
Dim lastRow As Long
lastRow = Worksheets("解決課題").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
If Worksheets("解決課題").Cells(i, 1) = kadaij Then
lstmeisai.AddItem Worksheets("解決課題").Cells(i, 2)
End If
Next
kadaijはpublicで定義しフォームを呼ぶときに指定する
リストボックスで2項目のデータの取り込み
Private Sub cmdNyuryoku_Click()
ActiveCell = kamokulist.Text
Cells(ActiveCell.Row, ActiveCell.Column + 1) = kamokulist.List(kamokulist.ListIndex, 1)
Unload Me
End Sub
検索フォームで引数の処理
Public Function PlbshowDialog(rstrTokuiCD As String, Optional rstrTokuiNm As String) As Integer
PlbshowDialog = -1
Me.Show vbModal
If m_strTokuiCd <> "" Then
rstrTokuiCD = m_strTokuiCd
rstrTokuiNm = m_strTokuiNm
PlbshowDialog = 0
End If
End Function
コンボボックスにデータの表示（For Nextステートメントの例）
lastRow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
cmbiroiro2.AddItem Worksheets("data").Cells(i, 1)
Next
コンボボックスにデータを登録（直接）
With cmbMaker
.AddItem "文化"
.AddItem "ＹＫＫ"
.AddItem "トステム"
End With
コンボボックスのデータの取り出し
maker = cmbMaker.Text
コンボボックスのデータの変化での取り出し
Private Sub cmbiroiro1_Change()
lblcombo1torikomi.Caption = cmbiroiro1.Text
txtcombo1torikomi.Text = cmbiroiro1.Text
End Sub
コンボボックスのデータのクリックでの取り出し
Private Sub cmbiroiro1_Click()
lblcombo1torikomi.Caption = cmbiroiro1.Text
txtcombo1torikomi.Text = cmbiroiro1.Text
End Sub
コンボボックスの2列の表示
With cmbkamoku
.ColumnCount = 2 '表示列数の設定
.TextColumn = 2 '表示列の設定
End With
For i = 2 To lastrow
With cmbkamoku
.AddItem
.List(i - 2, 0) = Worksheets("科目").Cells(i, 1)
.List(i - 2, 1) = Worksheets("科目").Cells(i, 2)
End With
Next
コンボボックスの2項目目の取り込み
Private Sub cmbkamoku_Click()
txtkarikamokucode.Text = cmbkamoku.List(cmbkamoku.ListIndex, 0)
End Sub
ボタンの２行の名前
SHIFTをおしながらALTを押すと次の行が入力できるようになる
フォームに線を引く方法
captionを使った方法
Private Sub UserForm_Initialize()
Label1.BorderStyle = fmBorderStyleSingle
Label1.Height = 1
End Sub
フォントの色
Worksheets("売掛金").Cells(kasig, 6).Font.ColorIndex = 3
他のフォームのオブジェクトの取り方
frmmitumori.lblpattern.Caption = strPname
チェックボックスの取り込み
If chkiroiro1 = True Then
lblchk1torikomi.Caption = chkiroiro1.Caption
End If
If chkiroiro2 = True Then
lblchk2torikomi.Caption = chkiroiro2.Caption
End If
If chkiroiro3 = True Then
lblchk3torikomi.Caption = chkiroiro3.Caption
End If
チェックボックスの複数の取り込み
Private Sub cmdjikkou_Click()
If chktext1 = True Then
txtkakunou.Text = txtkakunou.Text & chktext1.Caption
End If
If chktext2 = True Then
txtkakunou.Text = txtkakunou.Text & chktext2.Caption
End If
If chktext3 = True Then
txtkakunou.Text = txtkakunou.Text & chktext3.Caption
End If
If chktext4 = True Then
txtkakunou.Text = txtkakunou.Text & chktext4.Caption
End If
End Sub
チェックボックスのクリックでの取り込み
Private Sub chkiroiro1_Click()
If chkiroiro1 = True Then
lblchk1torikomi.Caption = chkiroiro1.Caption
Else
lblchk1torikomi.Caption = ""
End If
End Sub
オプションボタンの取り込み
Select Case True
Case optiroiro1
lbloptiontorikomi.Caption = optiroiro1.Caption
Case optiroiro2
lbloptiontorikomi.Caption = optiroiro2.Caption
End Select
オプションボタンのクリックの取り込み
Private Sub optiroiro1_Click()
If optiroiro1 Then
lbloptiontorikomi.Caption = optiroiro1.Caption
End If
End Sub
オプションボタンの取り方（if文）
If optnyukin.Value = True Then
Worksheets("仕訳帳").Cells(lastRow + 1, 2) = "現金"
Worksheets("仕訳帳").Cells(lastRow + 1, 4) = txtkamoku.Text
Else
If optsyukkin.Value = True Then
Worksheets("仕訳帳").Cells(lastRow + 1, 2) = txtkamoku.Text
Worksheets("仕訳帳").Cells(lastRow + 1, 4) = "現金"
End If
End If
オプションボタンの繰り返しをFor Nextで短くする
Select Case KeyCode
Case vbKeyReturn
For i = 1 To 10
If Controls("jyou" & i).Value = True Then
bjcode = Worksheets("部品").Cells(11 + i, 1)
bjtanka = Worksheets("部品").Cells(11 + i, 3)
bjzu = Worksheets("部品").Cells(11 + i, 4)
End If
Next
Case Else
Exit Sub
End Select
画像の取り込み
imgtotte.Picture = LoadPicture(btzu)
他のフォームを使える呼び出し方
Private Sub cmdrkensaku_Click()
riyousyakensaku.Show vbModeless
End Sub
２つのフォームを閉じる場合
Unload Me
Unload riyousyakensaku
順序に注意
フォームの移動時元のフォームを消してまた表示する
Me.Hide
UserForm3.Show
Me.Show
フォームへの引数の渡し方
フォームに直接引数を渡すのでなくPUBLIC変数を標準モジュールに設定してその変数を使ってフォームをコントロールする方法
Public furigana As String
Private Sub cmda_Click()
furigana = "ア"
riyousya.Show
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim lastRow As Long
With Worksheets("名簿").Range("C3")
.AutoFilter Field:=3, Criteria1:="=" & furigana & "*" 'オートフィルタで抽出
End With
コレクションを使ったオブジェクト配列
Private myCollect As New Collection
Private Sub UserForm_Initialize()
With myCollect
.Add Item:=TextBox1
.Add Item:=TextBox2
.Add Item:=TextBox3
.Add Item:=TextBox4
End With
End Sub
'Cells(1, 1)～Cells(1, 4)にTextBox1～TextBox4の値を順にセットする
Private Sub CommandButton1_Click()
Dim i As Long
For i = 1 To 4
Cells(1, i) = myCollect(i).Value
Next i
End Sub
