|
以前作成したの入れます、
勉強は↓で
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
|
|