Top> 部品(フォーム)

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

部品(フォーム)

フォームの表示

  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 "YKK"
    .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

ボタンの2行の名前

  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

2つのフォームを閉じる場合

  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

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)