Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

13771 / 76732

←次へ　｜　前へ→


	【68463】VBAからAccess読込際に、わからない箇所がある。

TEA - 11/3/9(水) 11:46 -


	引用なし

	パスワード

はじめまして。
今VBAを使って家計簿を作成しているのですが、初心者の私には、
わからないところがありますので、教えてほしく、質問させていただきました。

現在、Accessのデータの読込まではできているのですが、
解決できず困っている箇所があります。

まだ、内容は浅いですが簡単に仕様を乗せます。
☆仕様☆
1:カレンダー画面の日付を押下することで、Accessに登録したﾃﾞｰﾀを取得。
　⇒ユーザフォーム画面に日付を取得する。
2:ユーザフォーム画面にて１～６件ずつ登録することが可能
　⇒１～６件までの登録操作時はスピンボタンは非活性状態とし、7件目からは次のページ(スピンボタンは活性状態)操作が可能とする。
4:裏の処理として、日付とNoを取得するようにしている。
　⇒7件目以降のNoの処理が必要である。

＿＿＿＿＿＿＿＿＿＿
|________日付_______|
|_1_|_2_|_3_|_4_|_5_|
|_6_|_7_|_8_|_9_|_10|
|_11|_12|_13|_14|_15|

↓Accessからﾃﾞｰﾀを取得する。
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
|項目　詳細　支出　収入　口座|
|＿＿　＿＿　＿＿　＿＿　＿＿|
|＿＿||＿＿||＿＿||＿＿||＿＿|
|＿＿＿＿＿＿＿＿＿＿＿＿＿＿|

☆プログラム☆
＞カレンダーの処理
Option Explicit
Const cnsADO_CONNECT1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Const cnsADO_CONNECT2 = "\db1.mdb;"

Const adOpenKeyset = 1
Const adLockReadOnly = 1

Private colDataControls As Collection
Private colDataControl As Collection

Private Sub Calendar_Click()

Dim Nen As String
Dim Gatu As String
Dim Hi As String
Dim dbCon As Object
Dim dbRes As Object
Dim dbCols As Object
Dim strSQL As String
Dim GYO As Long
Dim GYO02 As Long
Dim Hiduke As String
Dim col0 As Collection
Dim col1 As Collection
Dim i As Long
Dim j As Long
Dim k As Long

Nen = Calendar.Year
Gatu = Calendar.Month
Hi = Calendar.Day
UserForm1.Hiduke.Caption = Nen & "年" & Gatu & "月" & Hi & "日"
　　Worksheets("Sheet2").Activate
　　
' 接続を確立する
　　Set dbCon = CreateObject("ADODB.Connection")
　　dbCon.Open cnsADO_CONNECT1 & ThisWorkbook.Path & cnsADO_CONNECT2
　' テーブル名,条件を指定してレコードセットを取得する
　　strSQL = "SELECT * FROM kakeibo WHERE date=" & """" & Calendar.Year & Format(Calendar.Month, "00") & Format(Calendar.Day, "00") & """" & " ORDER BY no"
Set dbRes = CreateObject("ADODB.Recordset")
dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly

' 先頭レコードからEOFまで繰り返す
GYO = 1
i = 1
j = 1
If (GYO > i) Then
For i = (i - 1) * 6 + 1 To (i - 1) * 6 + 6
Set colDataControls = New Collection
　　　　
Set colDataControl = New Collection
colDataControl.Add UserForm1.ComboBox1
colDataControl.Add UserForm1.Syosai1
colDataControl.Add UserForm1.Shisyutsu1
colDataControl.Add UserForm1.Syunyu1
colDataControl.Add UserForm1.ComboBox2
colDataControls.Add colDataControl
　　　　
Set colDataControl = New Collection
colDataControl.Add UserForm1.ComboBox3
colDataControl.Add UserForm1.Syosai2
colDataControl.Add UserForm1.Shisyutsu2
colDataControl.Add UserForm1.Syunyu2
colDataControl.Add UserForm1.ComboBox4
colDataControls.Add colDataControl
　　　　
Set colDataControl = New Collection
colDataControl.Add UserForm1.ComboBox8
colDataControl.Add UserForm1.Syosai3
colDataControl.Add UserForm1.Shisyutsu3
colDataControl.Add UserForm1.Syunyu3
colDataControl.Add UserForm1.ComboBox5
colDataControls.Add colDataControl
　　　　
Set colDataControl = New Collection
colDataControl.Add UserForm1.ComboBox7
colDataControl.Add UserForm1.Syosai4
colDataControl.Add UserForm1.Shisyutsu4
colDataControl.Add UserForm1.Syunyu4
colDataControl.Add UserForm1.ComboBox6
colDataControls.Add colDataControl
　　　　
Set colDataControl = New Collection
colDataControl.Add UserForm1.ComboBox12
colDataControl.Add UserForm1.Syosai5
colDataControl.Add UserForm1.Shisyutsu5
colDataControl.Add UserForm1.Syunyu5
colDataControl.Add UserForm1.ComboBox9
colDataControls.Add colDataControl
　　　　
Set colDataControl = New Collection
colDataControl.Add UserForm1.ComboBox11
colDataControl.Add UserForm1.Syosai6
colDataControl.Add UserForm1.Shisyutsu6
colDataControl.Add UserForm1.Syunyu6
colDataControl.Add UserForm1.ComboBox10
colDataControls.Add colDataControl
'==ここまで
Next i
j = j + 1
End If
For GYO = 1 To dbRes.RecordCount
' 行の変数を加算し必要項目を選択してセルにセット
　　　　
Set dbCols = dbRes.Fields
colDataControls.Item(GYO).Item(1).Value = dbCols("koumoku").Value
colDataControls.Item(GYO).Item(2).Text = dbCols("shousai").Value
colDataControls.Item(GYO).Item(3).Text = dbCols("shisyutsu").Value
colDataControls.Item(GYO).Item(4).Text = dbCols("shunyu").Value
colDataControls.Item(GYO).Item(5).Value = dbCols("kouza").Value
　　　　
' 次のレコードに移る
dbRes.MoveNext
Next GYO
　　　　

' レコードセット、データベースを閉じる
dbRes.Close
Set dbRes = Nothing
dbCon.Close
Set dbCon = Nothing

UserForm1.Show 1
End Sub

＞ユーザフォーム画面
Option Explicit
Const cnsADO_CONNECT1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Const cnsADO_CONNECT2 = "\db1.mdb;"

Private colDataControls As Collection
Private colDataControl As Collection

Private Sub ComboBox3_Change()

End Sub
残高の計算を練り直す
Private Sub CommandButton1_Click()
Dim Syuunyu As Integer
Dim Shishutu As Integer
Dim Zandakabun As Integer
Syuunyu = Val(Syunyu1.Text) + Val(Syunyu2.Text) + Val(Syunyu3.Text) + Val(Syunyu4.Text) + Val(Syunyu5.Text) + Val(Syunyu6.Text)
Shishutu = Val(Shisyutsu1.Text) + Val(Shisyutsu2.Text) + Val(Shisyutsu3.Text) + Val(Shisyutsu4.Text) + Val(Shisyutsu5.Text) + Val(Shisyutsu6.Text)
Zandakabun = Syuunyu - Shishutu

Zandaka.Text = Zandakabun

End Sub

Private Sub CommandButton2_Click()

Dim i As Integer
Dim j As Integer
Dim GYO As Long
Dim dbCon As New ADODB.Connection
Dim dbRes As New ADODB.Recordset
Dim strSQL As String
Dim strMSG As String
Dim Strdate As String
　
' 接続を確立する
dbCon.Open cnsADO_CONNECT1 & ThisWorkbook.Path & cnsADO_CONNECT2

'<ﾃﾞｰﾀ入力画面にて入力操作の実行>
Set dbRes = New ADODB.Recordset
'dbCon.BeginTrans
　　For GYO = 1 To 6
　　' テーブル名,条件を指定してレコードセットを取得する(順位)
　　　　Strdate = Calendar_01.Calendar.Year & Format(Calendar_01.Calendar.Month, "00") & Format(Calendar_01.Calendar.Day, "00")
　　　　strSQL = "kakeibo WHERE date=" & """" & Strdate & """" & "and no=" & """" & GYO & """"

　　With dbRes
' 該当キーのレコードを取得
　　　If .EOF = True Then
　　　' 未登録の場合は新規作成(INSERT)させる
　　　.AddNew
　　　.Fields(0).Value = Strdate　　　　　　 ' 日付
　　　.Fields(1).Value = GYO　　　　　　　　 ' No.
　　　'End If
　　　　　　
　　.Fields(2).Value = colDataControls.Item(GYO).Item(1).Value　 ' 項目
　　.Fields(3).Value = colDataControls.Item(GYO).Item(2).Text　　' 詳細
　　.Fields(4).Value = Val(colDataControls.Item(GYO).Item(3).Text)' 支出
　　.Fields(5).Value = Val(colDataControls.Item(GYO).Item(4).Text)' 収入
　　.Fields(6).Value = colDataControls.Item(GYO).Item(5).Value　　 ' 口座
　　.Update
　　 MsgBox "登録完了！！"
　　.Close
　　End If
End With
　Next GYO
'dbCon.CommitTrans
End Sub

Private Sub CommandButton4_Click()
'<『閉じる』ﾎﾞﾀﾝの処理>
Unload Me
End Sub
'Private Sub UserForm_Click()
'<画面遷移直後>
'4.日付選択画面で選択した日付を表示する。
Private Sub SpinButton1_Change()
　　 SpinButton1.Min = 1
　　 SpinButton1.Max = 100
TextBox1.Text = SpinButton1.Value
End Sub

Private Sub UserForm_Initialize()
Dim rec As Collection

Set colDataControls = New Collection
Set colDataControl = New Collection
colDataControl.Add ComboBox1
colDataControl.Add Syosai1
colDataControl.Add Shisyutsu1
colDataControl.Add Syunyu1
colDataControl.Add ComboBox2
colDataControls.Add colDataControl

Set colDataControl = New Collection
colDataControl.Add ComboBox3
colDataControl.Add Syosai2
colDataControl.Add Shisyutsu2
colDataControl.Add Syunyu2
colDataControl.Add ComboBox4
colDataControls.Add colDataControl

Set colDataControl = New Collection
colDataControl.Add ComboBox8
colDataControl.Add Syosai3
colDataControl.Add Shisyutsu3
colDataControl.Add Syunyu3
colDataControl.Add ComboBox5
colDataControls.Add colDataControl

Set colDataControl = New Collection
colDataControl.Add ComboBox7
colDataControl.Add Syosai4
colDataControl.Add Shisyutsu4
colDataControl.Add Syunyu4
colDataControl.Add ComboBox6
colDataControls.Add colDataControl

Set colDataControl = New Collection
colDataControl.Add ComboBox12
colDataControl.Add Syosai5
colDataControl.Add Shisyutsu5
colDataControl.Add Syunyu5
colDataControl.Add ComboBox9
colDataControls.Add colDataControl

Set colDataControl = New Collection
colDataControl.Add ComboBox11
colDataControl.Add Syosai6
colDataControl.Add Shisyutsu6
colDataControl.Add Syunyu6
colDataControl.Add ComboBox10
colDataControls.Add colDataControl

For Each rec In colDataControls
　　rec(1).Style = fmStyleDropDownList
　　rec(1).RowSource = ""
　　rec(1).Clear
　　'収入
　　rec(1).AddItem "給料日"
　　rec(1).AddItem "ボーナス"
　　rec(1).AddItem "臨時収入"
　　'支出
　　rec(1).AddItem "食費"
　　rec(1).AddItem "光熱費"
　　rec(1).AddItem "支払"
　　rec(1).AddItem "美容"
　　rec(1).AddItem "遊楽"
　　rec(1).AddItem "その他"
　　rec(1).ListIndex = -1
　　
　　rec(5).Style = fmStyleDropDownList
　　rec(5).RowSource = ""
　　rec(5).Clear
　　rec(5).AddItem "現金"
　　'収入
　　rec(5).AddItem "口座"
　　'支出
　　rec(5).AddItem "ｸﾚｼﾞｯﾄ"
　　rec(5).AddItem "口座引落"
　　rec(5).ListIndex = -1
Next rec
End Sub

現在、この部分で悩んでます。
*１～６件の読み取りに成功したが、降順で読み取られているので、昇順で読み取りを行いたい。
*7件目以上の場合、スピンボタンにてページが読み取れるようにし、新たなページを追加する処理を加えたい。
*一回目の登録は可能だが、2回目の登録ができない。7件目以降のNo取得の処理の仕方がわからない。

どうぞ、ご指摘・ご教授願います。

1 hits

▼

【68463】VBAからAccess読込際に、わからない箇所がある。 TEA 11/3/9(水) 11:46

≪