Excel VBA質問箱 IV

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

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


57154 / 76732 ←次へ | 前へ→

【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
3 hits

【24311】VBAからAccessのデータを… masa 05/4/19(火) 10:29 質問
【24314】Re:VBAからAccessのデータを… ちゃっぴ 05/4/19(火) 10:53 回答
【24318】Re:VBAからAccessのデータを… m2 05/4/19(火) 11:33 発言
【24355】Re:VBAからAccessのデータを… masa 05/4/20(水) 10:24 お礼

57154 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free