Top > 財務管理> フォームを使った仕訳伝票入力

VBA通信教材申込み

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

申込 ヤフーショッピング

フォームを使った仕訳伝票入力

(2)フォームを使った仕訳伝票入力

フォームを使った仕訳伝票入力

ボタンの呼び出し

Sub 仕訳伝票フォーム()
  frmsiwake.Show
End Sub

日付入力のチェック

入力後エンターを押した時キーコードを判断する
If KeyCode = vbKeyReturn
日付の長さLen(txthiduke.Text)を判断し8桁から10桁のみ入力可能にしている。
Private Sub txthiduke_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = vbKeyReturn Then
    Select Case Len(txthiduke.Text)
      Case 0 To 2
        MsgBox "桁数が少ない(12/3)"
        Exit Sub
      Case 6 To 7
        MsgBox "桁数が少ない(2012/12/3) "
        Exit Sub
      Case Is >= 11
        MsgBox "桁数が多い "
        Exit Sub
    End Select
  End If
End Sub

仕訳伝票フォームのキャンセル

Private Sub cmdCancel_Click()
  Unload Me
End Sub

科目コードを直接入力したとき科目名を検索する関数

標準モジュールに記述
Function kamokukensakuf(kcode As Long) As String
    Dim lastrow As Long
    Dim i As Long
    lastrow = Worksheets("科目表").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
      If kcode = Worksheets("科目表").Cells(i, 1) Then
        kamokukensakuf = Worksheets("科目表").Cells(i, 2)
        Exit Function
      End If
    Next
    kamokukensakuf = ""
    MsgBox "科目コードがみつかりません"
End Function

仕訳帳シートに追加登録する。

フォームのオブジェクトを仕訳帳シートに追加するがフォームのオブジェクトは配列が
使えないためCollectionとAdd Itemを使っての30個のオブジェクトを作成する。
借方コード、借方名、金額、貸方コード、貸方名、摘要と6x5行分のオブジェクトを書いている
またCollectionを使ってプロシージャの外側に書いているためそのモジュール全体で使えるようにしている。
Private myCollectrc As New Collection
Private myCollectrn As New Collection
Private myCollectki As New Collection
Private myCollectsc As New Collection
Private myCollectsn As New Collection
Private myCollecttk As New Collection
フォームを呼び出したときに30個のCollectionを作っている。
Private Sub UserForm_Initialize()
'借方コード
  With myCollectrc
      .Add Item:=txtkaric1
      .Add Item:=txtkaric2
      .Add Item:=txtkaric3
      .Add Item:=txtkaric4
      .Add Item:=txtkaric5
  End With
'借方科目
  With myCollectrn
      .Add Item:=lblkarin1
      .Add Item:=lblkarin2
      .Add Item:=lblkarin3
      .Add Item:=lblkarin4
      .Add Item:=lblkarin5
  End With
'金額
  With myCollectki
      .Add Item:=txtkingaku1
      .Add Item:=txtkingaku2
      .Add Item:=txtkingaku3
      .Add Item:=txtkingaku4
      .Add Item:=txtkingaku5
  End With
'貸方コード
  With myCollectsc
      .Add Item:=txtkasic1
      .Add Item:=txtkasic2
      .Add Item:=txtkasic3
      .Add Item:=txtkasic4
      .Add Item:=txtkasic5
  End With
'貸方科目
  With myCollectsn
      .Add Item:=lblkasin1
      .Add Item:=lblkasin2
      .Add Item:=lblkasin3
      .Add Item:=lblkasin4
      .Add Item:=lblkasin5
  End With
'摘要
  With myCollecttk
      .Add Item:=txttekiyou1
      .Add Item:=txttekiyou2
      .Add Item:=txttekiyou3
      .Add Item:=txttekiyou4
      .Add Item:=txttekiyou5
  End With
End Sub
5行の固定入力画面であるが、入力されている行のみ登録している
借方科目コードが入力されているかで判断している。
Private Sub cmdtouroku_Click()
  Dim lastrow As Long
  Dim i As Long
  lastrow = Worksheets("仕訳帳").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To 5
    If myCollectrc(i).Text <> "" Then
      Worksheets("仕訳帳").Cells(lastrow + i, 1) = txthiduke.Text
      Worksheets("仕訳帳").Cells(lastrow + i, 2) = myCollectrc(i).Text
      Worksheets("仕訳帳").Cells(lastrow + i, 2) = myCollectrn(i).Caption
      Worksheets("仕訳帳").Cells(lastrow + i, 4) = myCollectki(i).Text
      Worksheets("仕訳帳").Cells(lastrow + i, 5) = myCollectsc(i).Text
      Worksheets("仕訳帳").Cells(lastrow + i, 6) = myCollectsn(i).Caption
      Worksheets("仕訳帳").Cells(lastrow + i, 7) = myCollectki(i).Text
      Worksheets("仕訳帳").Cells(lastrow + i, 8) = myCollecttk(i).Text
    End If
  Next
  txthiduke.Text = ""
  For i = 1 To 5
    myCollectrc(i).Text = ""
    myCollectrn(i).Caption = ""
    myCollectki(i).Text = ""
    myCollectsc(i).Text = ""
    myCollectsn(i).Caption = ""
    myCollecttk(i).Text = ""
  Next
End Sub

科目コードのHELP画面を使って入力をしやすくする。

科目検索フォームに記述している
伝票入力の科目コードでスペースキーを押したときに表示するようにしているために
m_lngkamokucとm_strkamokuNmの変数を使ってPlbshowDialogの関数の引数を0
か1で判断して科目コード・科目名を仕訳伝票に持ってきている。

フォームを使った仕訳伝票入力

Private m_lngkamokuc As Long
Private m_strkamokuNm As String
Private Sub cmdCancel_Click()
  Unload Me
End Sub
Private Sub cmdJikkou_Click()
  If kamokulist.ListIndex = -1 Then Exit Sub
  m_lngkamokuc = kamokulist.Value
  m_strkamokuNm = kamokulist.List(kamokulist.ListIndex, 1)
  Me.Hide
End Sub
Private Sub UserForm_Initialize()
  Dim i As Long
  Dim lastrow As Long
  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
End Sub
Private Sub kamokulist_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If kamokulist.ListIndex = -1 Then Exit Sub
  m_lngkamokuc = kamokulist.Value
  m_strkamokuNm = kamokulist.List(kamokulist.ListIndex, 1)
  Me.Hide
End Sub
Public Function PlbshowDialog(rlngkamokuc As Long, Optional rstrkamokuNm As String) As Long
  PlbshowDialog = -1
  Me.Show vbModal
  If m_lngkamokuc <> 0 Then
    rlngkamokuc = m_lngkamokuc
    rstrkamokuNm = m_strkamokuNm
    PlbshowDialog = 0
  End If
End Function
各行の借方コード・貸方コード10個のプロシージャを書いている
先ほど述べたようにオブジェクトの配列が使えないために、単純に10個記述している。
コード入力の項目でコード番号入力後エンターを押したときの処理
vbKeyReturnを判断して、kamokukensakufの関数で科目名を検索している。
何も入力しないでスペースを押したときの処理
vbKeySpaceを判断して、
    intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
    If intShowStatus <> 0 Then Exit Sub
でHELP検索の画面に飛び科目コード番号科目名を持ってくる

1行目借方コード

Private Sub txtkaric1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkaric1.Text = "" Then
        Exit Sub
      End If
      lblkarin1.Caption = kamokukensakuf(txtkaric1.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkaric1.Text = lngkamokuc
  lblkarin1.Caption = strkamokuNm
End Sub

2行目借方コード

Private Sub txtkaric2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkaric2.Text = "" Then
        Exit Sub
      End If
      lblkarin2.Caption = kamokukensakuf(txtkaric2.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkaric2.Text = lngkamokuc
  lblkarin2.Caption = strkamokuNm
End Sub

3行目借方コード

Private Sub txtkaric3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkaric3.Text = "" Then
        Exit Sub
      End If
      lblkarin3.Caption = kamokukensakuf(txtkaric3.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkaric3.Text = lngkamokuc
  lblkarin3.Caption = strkamokuNm
End Sub

4行目借方コード

Private Sub txtkaric4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkaric4.Text = "" Then
        Exit Sub
      End If
      lblkarin4.Caption = kamokukensakuf(txtkaric4.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkaric4.Text = lngkamokuc
  lblkarin4.Caption = strkamokuNm
End Sub

4行目借方コード

Private Sub txtkaric5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkaric5.Text = "" Then
Exit Sub
      End If
      lblkarin5.Caption = kamokukensakuf(txtkaric5.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkaric5.Text = lngkamokuc
  lblkarin5.Caption = strkamokuNm
End Sub

1行目貸方コード

Private Sub txtkasic1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkasic1.Text = "" Then
        Exit Sub
      End If
      lblkasin1.Caption = kamokukensakuf(txtkasic1.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkasic1.Text = lngkamokuc
  lblkasin1.Caption = strkamokuNm
End Sub

2行目貸方コード

Private Sub txtkasic2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkasic2.Text = "" Then
        Exit Sub
      End If
      lblkasin2.Caption = kamokukensakuf(txtkasic2.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkasic2.Text = lngkamokuc
  lblkasin2.Caption = strkamokuNm
End Sub

3行目貸方コード

Private Sub txtkasic3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkasic3.Text = "" Then
        Exit Sub
      End If
      lblkasin3.Caption = kamokukensakuf(txtkasic3.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkasic3.Text = lngkamokuc
  lblkasin3.Caption = strkamokuNm
End Sub

4行目貸方コード

Private Sub txtkasic4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkasic4.Text = "" Then
        Exit Sub
      End If
      lblkasin4.Caption = kamokukensakuf(txtkasic4.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkasic4.Text = lngkamokuc
  lblkasin4.Caption = strkamokuNm
End Sub

5行目貸方コード

Private Sub txtkasic5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim intShowStatus As Long
  Dim lngkamokuc As Long
  Dim strkamokuNm As String
  Select Case KeyCode
    Case vbKeySpace
      intShowStatus = frmkamoku.PlbshowDialog(lngkamokuc, strkamokuNm)
      If intShowStatus <> 0 Then Exit Sub
    Case vbKeyReturn
      If txtkasic5.Text = "" Then
        Exit Sub
      End If
      lblkasin5.Caption = kamokukensakuf(txtkasic5.Text)
      Exit Sub
    Case Else
      Exit Sub
  End Select
  txtkasic5.Text = lngkamokuc
  lblkasin5.Caption = strkamokuNm
End Sub

先頭へ

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