FJ Software

perfekt danke

jetzt läuft aber die liste ganz schnell von oben nach unten durch weil das "enter" zu schnell kommt und bei der excel abfrage auf "ja" drückt.
Die übergabe an MPE dauert ein ca. eine halbe Sekunde und somit wird mit deinem code nur die letzte nummer in der liste angerufen.

ich habe jetzt ein wenig gegoogelt und 1 sekunde pause eingebaut bevor "enter" gedrückt wird.
der code funktioniert, aber falls man das anders macht bitte um info bzw. korrektur

Code: Alles auswählen

Sub MPE_Call()
  Dim JaNein As Integer, Meldetext As String
  Dim y As Long
 
  y = ActiveCell.Row - 1
  Cells(1, 3).Copy
  Application.Wait (Now + TimeValue("0:00:01"))
  SendKeys "{Enter}"
  Do
  y = y + 1
      Do
        If Cells(y, 3).Font.Bold = True Then
          y = y + 1
        Else
          Exit Do
        End If
      Loop
      If Cells(y, 1) = "" Then Exit Sub
      Cells(y, 3).Copy
      Application.Wait (Now + TimeValue("0:00:01"))
      SendKeys "{Enter}"
      Meldetext = Cells(y, 1) & " " & Cells(y, 2) & ": " & Cells(y, 3) & " erledigt?"
      JaNein = MsgBox(Meldetext, 3)
      If JaNein = 2 Then
        Exit Sub
      End If
      If JaNein = 6 Then
        Cells(y, 3).Font.Bold = True
      End If
     
  Loop
End Sub

ist es möglich in spalte 4 das aktuelle datum, dann space und dann das aktuelle datum in die tabelle zu schreiben damit man weiß wann der wählversuch war?
so soll das dann aussehen:

28.10.2021 23:41

ich hab das zwar auch gegoogelt, aber ich werd daraus nicht schlau. Leider habe ich in der HTL nur C++ gelernt und das auch nur minimal, daher kann ich leider nicht programmieren

Ich habe den Code noch etwas gekürzt, und wie von Dir gewünscht "Datum Urzeit" in die Spalte 4 setzen lassen.

Code: Alles auswählen

Sub MPE_Call()
  Dim JaNein As Integer, Meldetext As String
  Dim y As Long
  
  y = 1
  Do
    y = y + 1
    Do
      If Cells(y, 3).Font.Bold = True Then
        y = y + 1
      Else
        Exit Do
      End If
    Loop
    If Cells(y, 1) = "" Then Exit Sub
    With Cells(y, 4)
      .Value = Now
      .NumberFormat = "dd/mm/yy hh:mm"
    End With
    Cells(y, 3).Copy
    Application.Wait (Now + TimeValue("0:00:01"))
    SendKeys "{Enter}"
    Meldetext = Cells(y, 1) & " " & Cells(y, 2) & ": " & Cells(y, 3) & " erledigt?"
    JaNein = MsgBox(Meldetext, 3)
    If JaNein = 2 Then
      Exit Sub
    End If
    If JaNein = 6 Then
      Cells(y, 3).Font.Bold = True
    End If
  Loop
End Sub

@icke1954
Riesigen Dank für deine tolle Unterstützung!!!

Mir ist scheinbar heute der "Programmierknopf" aufgegangen und ich habe die Logik hinter deinem Code verstanden und noch weiter angepasst. So weit ich das jetzt getestet habe funktioniert alles wie es soll.
Falls irgendein Anfängerfehler passiert ist, bitte um Rückmeldung.

Ein weiterer Wunsch war, dass bei einem Abbruch "gespeichert" wird wem ich zuletzt angerufen habe und bei erneutem Klicken auf "Anrufen" an dieser Stelle weitergemacht wird.
Dies habe ich so gelöst, dass in Spalte 5 die aktuelle Zeilennummer geschrieben wird und dann in E1 mittels Formel

Code: Alles auswählen

=MAX(E2:E1000)

den höchsten Wert ermittle und in dieser Zeile + 1 weitermache.
Sämtliche Versuche dies über VB zu ermitteln sind leider gescheitert

Nach meiner Veränderung wurden dann beim Fortsetzen immer die erste Nummer auf bold geändert, obwohl ich auf "nicht erreicht" geklickt habe, auch diesen Fehler habe ich mit einer weiteren 1 Sekunden Pause nach dem Anrufen wegbekommen

Zu guter Letzt habe ich den "Deaktivieren" Button auf einen "Reset" Button umgebaut, damit die Telefonnummern von Bold auf Normal gesetzt werden und die Anrufzeiten und die Zeilennummern gelöscht werden.

Code: Alles auswählen

Private Sub cbFett_Click()
Range(Cells(2, 3), Cells(10000, 3)).Font.Bold = False
Range(Cells(2, 4), Cells(10000, 4)).Clear
Range(Cells(2, 5), Cells(10000, 5)).Clear
End Sub

Code: Alles auswählen

Sub MPE_Call()
  Dim JaNein As Integer, Meldetext As String
  Dim y As Long
 
  y = Cells(1, 5)
  Do
    y = y + 1
    Do
      If Cells(y, 3).Font.Bold = True Then
        y = y + 1
      Else
        Exit Do
      End If
    Loop
    If Cells(y, 1) = "" Then Exit Sub
    With Cells(y, 4)
      .Value = Now
      .NumberFormat = "dd/mm/yy hh:mm"
    End With
    With Cells(y, 5)
      .Value = y
    End With
    Cells(y, 3).Copy
    Application.Wait (Now + TimeValue("0:00:01"))
    SendKeys "{Enter}"
    Application.Wait (Now + TimeValue("0:00:01"))
    Meldetext = Cells(y, 1) & " " & Cells(y, 2) & ": " & Cells(y, 3) & " erledigt?"
    JaNein = MsgBox(Meldetext, 3)
    If JaNein = 2 Then
      Exit Sub
    End If
    If JaNein = 6 Then
      Cells(y, 3).Font.Bold = True
    End If
  Loop
End Sub

FJ Software

Automatische Wahl der Kontakte