Option Explicit

Private Sub Command_OpenCom_Click()

If Command_OpenCom.Caption = "COM öffnen" Then
    'Serielle Schnittstelle öffnen
    If OPENCOM(Combo_Com.Text & ":" & Combo_Baud.Text & _
    ",n,8,1") = 0 Then
        MsgBox ("Fehler, kann " & Combo_Com.Text & " nicht öffnen")
    Else
        SDA 1 'I2C-Interface testen
        If Not SDA_in Then
            MsgBox ("Keine Antwort vom I2C-Seriell Interface")
            'Serielle Schnittstelle schließen
            CLOSECOM
        Else
            'I2C-Bus initialisieren
            i2cInit
            i2cStart
            i2cNoAck
            i2cStop
            Command_OpenCom.Caption = "COM schließen"
            Command_By_lesen.Enabled = True
            Command_By_schreiben.Enabled = True
            Command_Block_lesen.Enabled = True
            Command_Block_schreiben.Enabled = True
        End If
    End If
Else
    'Serielle Schnittstelle schließen
    CLOSECOM
    Command_OpenCom.Caption = "COM öffnen"
    Command_By_lesen.Enabled = False
    Command_By_schreiben.Enabled = False
    Command_Block_lesen.Enabled = False
    Command_Block_schreiben.Enabled = False
End If
End Sub 

Private Sub Command_By_lesen_Click()

i2cStart
If i2cSlave(Combo_Adresse.Text) Then       'Bus-Adresse
    i2cOut TextBox_ByAdresse.Text          'Byteadresse
    i2cStop
    i2cStart
    i2cOut Combo_Adresse.Text + 1          'Bus-Adresse
    TextBox_ByWert.Text = i2cIn            'Wert vom EEprom lesen
End If
i2cNoAck
i2cStop
End Sub 

Private Sub Command_By_schreiben_Click()
On Error GoTo ErrorHandler

If TextBox_ByWert.Text > 255 Then
    MsgBox ("Im Feld WERT nur Zahlen <= 255 erlaubt")
Else
    i2cStart
    If i2cSlave(Combo_Adresse.Text) Then  'Bus-Adresse
        i2cOut TextBox_ByAdresse.Text     'Byteadresse
        i2cOut TextBox_ByWert.Text        'Wert zum EEprom schreiben
        i2cStop
    End If
    i2cStop
End If

ErrorHandler:
Select Case Err.Number              'Fehlernummer auswerten.
    Case 0 'ok
    Case 13
         MsgBox ("Im Feld WERT nur Zahlen erlaubt")
         TextBox_ByWert.Text = ""
    Case Else
        MsgBox ("Fehler " & Err.Number)
    End Select
End Sub 

Private Sub Command_Block_lesen_Click()
Dim i, ii, Wert, BlAnz, ByAdr
BlAnz = TextBox_BlockAnz.Text
ByAdr = TextBox_BlockAdr.Text

For i = 13 To 100: Rows(i).Clear: Next i   'Zeilen im Excelblatt löschen
Range("A1:A100").Font.Bold = True          'Spalte in Fettschrift

i2cStart
If i2cSlave(Combo_Adresse.Text) Then       'Bus-Adresse
  i2cOut TextBox_BlockAdr.Text             'Byteadresse
  i2cStop
  i2cStart
  i2cOut Combo_Adresse.Text + 1 'Bus-Adresse des EEproms zum Lesen
  
  For i = 0 To BlAnz - 1
    Cells(i + 13, 1) = ByAdr
    For ii = 0 To 7                        '8 Bytes auslesen
        If ByAdr + ii <= 255 Then
          Wert = i2cIn                     'Wert vom EEprom lesen
          Cells(i + 13, ii + 2) = Wert
          If ii <> 7 Then
            i2cAck                         'Ack schicken
          End If
        Else
          i2cNoAck
          i2cStop
          Exit Sub
        End If
    Next ii
    ByAdr = ByAdr + 8                      'die nächsten 8 Bytes lesen
    If i <> BlAnz - 1 Then
        i2cAck                             'Ack schicken
    End If
  Next i
End If
i2cNoAck
i2cStop
End Sub 

Private Sub Command_Block_schreiben_Click()
Dim i, ii, Wert, BlAnz, ByAdr
BlAnz = TextBox_BlockAnz.Text
ByAdr = TextBox_BlockAdr.Text

On Error GoTo ErrorHandler

For i = 0 To BlAnz - 1
  i2cStart
  If i2cSlave(Combo_Adresse.Text) Then      'Bus-Adresse
    i2cOut ByAdr                            'Byteadresse
    For ii = 0 To 7                        '16 Bytes schreiben
        If ByAdr + ii <= 255 Then
          Wert = Cells(i + 13, ii + 2)
          If Wert > 255 Then
            MsgBox ("Wert in Zelle " & Chr$(66 + ii) & i + 13 & " ungültig")
            Cells(i + 13, ii + 2) = 0
            i2cNoAck
            i2cStop
            Exit Sub
          Else
            i2cOut Wert 'Byte zum EEprom übertragen
          End If
        Else
          i2cNoAck
          i2cStop
          Exit Sub
        End If
    Next ii
    i2cStop            'Werte werden gebrannt
    DELAY 20           '20 ms warten bis Daten geschrieben sind
    ByAdr = ByAdr + 8  'die nächsten 8 Bytes schreiben
  Else
    i2cNoAck
    i2cStop
    Exit Sub
  End If
Next i
i2cNoAck
i2cStop

ErrorHandler:
Select Case Err.Number              'Fehlernummer auswerten.
    Case 0 'ok
    Case 13
        MsgBox ("Nur Zahlen erlaubt" & vbCrLf & _
        "Wert in Zelle " & Chr$(66 + ii) & i + 13 & " ungültig")
        Cells(i + 13, ii + 2) = 0
    Case Else
        MsgBox ("anderer Fehler " & Err.Number)
    End Select
End Sub 

Bausätze können Sie günstig in unserem Onlineshop in der Rubrik "I2C-Komponenten" bestellen.