Excel VBA質問箱 IV

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

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


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

57229 / 76807

←次へ　｜　前へ→


	【24318】Re:VBAからAccessのデータを…

m2 - 05/4/19(火) 11:33 -


	引用なし

	パスワード

以前作成したの入れます、

勉強は↓で

http://www.geocities.jp/cbc_vbnet/

Private MyPath As String
Private cnn As New ADODB.Connection
Private rec As New ADODB.Recordset
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

　　If ActiveCell.Address = "$C$5" Then
　　　 If Range("c4") = "" Then Range("c4").Select
　　　 Range("c4") = Format(Range("c4"), "0000000")
　　　 Da_Get
　　End If
　　
　　If ActiveCell.Address = "$C$11" Then
　　　 Da_Put
　　　 Range("c4").Select
　　End If
　　
End Sub

Public Sub Da_Get()

　　MyPath = ActiveWorkbook.Path & "\A地区.Mdb"
　　cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MyPath & ";"
　　rec.Open "所有者名簿", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
　　rec.Index = "名簿ID"
　　
　　With Sheets("名簿")
　　
'　　For i = 0 To rec.Fields.Count - 1
'　　　　 ActiveSheet.Cells(15, i + 1).Value = rec.Fields(i).Name
'　　　　 ActiveSheet.Cells(16, i + 1).Value = rec.Fields(i).ActualSize
'　　　　 ActiveSheet.Cells(17, i + 1).Value = rec.Fields(i).DefinedSize
'　　Next i

　　rec.Seek .Range("c4")
　　If rec.EOF Then
　　　　　　.Range("B2") = "新規"
　　　　　　.Range("c5:c10") = ""
　　　　 Else
　　　　　　.Range("c5") = rec![名前1]
　　　　　　.Range("c6") = rec![名前2]
　　　　　　.Range("c7") = rec![住所1]
　　　　　　.Range("c8") = rec![住所2]
　　　　　　.Range("c9") = rec![電話]
　　　　　　.Range("c10") = rec![郵便]
　　 End If
　　 End With
　　　
　　rec.Close: Set rec = Nothing
　　cnn.Close: Set cnn = Nothing
End Sub
Public Sub Da_Put()

　　MyPath = ActiveWorkbook.Path & "\A地区.Mdb"
　　cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MyPath & ";"
　　rec.Open "所有者名簿", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
　　rec.Index = "名簿ID"
　　
　　With Sheets("名簿")
　　rec.Seek .Range("c4")
　　
　　If rec.EOF Then
　　　　 rec.AddNew
　　　　　 .Range("B2") = "新規"
　　　　 Else
　　　　　 .Range("B2") = "修正"
　　End If

　　　　rec![キー] = .Range("c4")
　　　　rec![名前1] = .Range("c5")
　　　　rec![名前2] = .Range("c6")
　　　　rec![住所1] = .Range("c7")
　　　　rec![住所2] = .Range("c8")
　　　　rec![電話] = .Range("c9")
　　　　rec![郵便] = .Range("c10")
　　　　　
　　rec.Update
　　.Range("c4:c10") = ""
　　End With
　　
　　rec.Close: Set rec = Nothing
　　cnn.Close: Set cnn = Nothing
End Sub
Public Sub Da_Del()
　　MyPath = ActiveWorkbook.Path & "\A地区.Mdb"
　　cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MyPath & ";"
　　rec.Open "所有者名簿", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
　　rec.Index = "名簿ID"
　　
　　With Sheets("名簿")
　　rec.Seek Range("c4")
　　If rec.EOF Then
　　　　　 Ret = MsgBox(Prompt:="データなし")
　　　　 Else
　　　　　 Ret = MsgBox(Prompt:="データを削除しますか？", Buttons:=vbYesNo + vbCritical + vbDefaultButton2, Title:="削除確認")
　　　　　 If Ret = 6 Then rec.Delete
　　End If
　　.Range("c4:c10") = ""
　　End With
　　　
　　rec.Close: Set rec = Nothing
　　cnn.Close: Set cnn = Nothing
End Sub

0 hits

▼

【24311】VBAからAccessのデータを… masa 05/4/19(火) 10:29