-3
Mein Excel VBA-Makro stürzt Excel-Tabelle. Es könnte sein, weil ich Excel frage, um mehrere SMS Texte/E-Mails oder vielleicht meine keyval
Funktion zu senden.Excel 2013 stürzt ab
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim em As String
Dim st As String
Dim str As String
Dim em2 As String
Dim mon As Worksheet
Sub SingleButtonEvent()
Set mon = Sheets("MON")
st = ""
ActiveSheet.Unprotect
If ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row < 30 Then
a = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
If mon.Cells(a, "BB") = "" Then
'MsgBox "No Number in Column BB. Message Will Not Send", vbCritical
Exit Sub
Else
em = mon.Cells(a, "BB").Value
With Cells(a, "AV").Font
.Color = RGB(166, 166, 166)
.Size = 12
End With
Call SendSMS
End If
Else
For b = 1 To 29
If Cells(b, "B") <> 0 Then
a = b
If mon.Cells(a, "BB") = "" Then
Else
em = mon.Cells(a, "BB").Value
Call SendSMS
End If
End If
Next
End If
ActiveSheet.Protect
End Sub
Sub SendSMS()
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Fields.Update
iMsg.To = em
'Change Bellow email to your email
iMsg.From = "[email protected]"
iMsg.Subject = ""
c = Cells(a, "A").End(xlToRight).Column
st = ""
em2 = ""
If c > 2 Then
'st = Format(Date, "DDDD") & "<br/>"
For d = 3 To c
If Cells(a, d) <> "" And CInt(Cells(30, d).Value) <= 7 Then
st = st & Cells(30, d).Value & ". " & Application.WorksheetFunction.Clean(Cells(a, d).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 1).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 2).Value) & "<br/>"
d = d + 2
ElseIf Cells(a, d) <> "" And CInt(Cells(30, d).Value) > 7 Then
If em2 = "" Then
em2 = Cells(30, d).Value & ". " & Application.WorksheetFunction.Clean(Cells(a, d).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 1).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 2).Value) & "<br/>"
d = d + 2
Else
em2 = em2 & Cells(30, d).Value & ". " & Application.WorksheetFunction.Clean(Cells(a, d).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 1).Value) & " | " & Application.WorksheetFunction.Clean(Cells(a, d + 2).Value) & "<br/>"
d = d + 2
End If
Else
Exit Sub
End If
Next
End If
'If ActiveSheet.Name = "MON" Then
'str = Cells(a, "B").Value
'Else
'str = Cells(a, "B").Value
'End If
If em2 = "" Then
iMsg.HTMLBody = st & "Visa triet " & Cells(a, "AY").Value & "<br/>Total " & Cells(a, "B").Value & "<br/>"
Set iMsg.Configuration = iConf
iMsg.Send
Else
iMsg.HTMLBody = st
Set iMsg.Configuration = iConf
iMsg.Send
iMsg.HTMLBody = em2 & "Visa " & Cells(a, "AY").Value & "<br/>Total " & Cells(a, "B").Value & "<br/>"
Set iMsg.Configuration = iConf
iMsg.Send
End If
Set iMsg = Nothing
End Sub
Function KeyVal(ParamArray ran() As Variant)
Application.Volatile True
Dim str As String
a = 0
Do While a < UBound(ran) + 1
If ran(a) = 0 Or ran(a) = "" Then
a = a + 1
Else
b = Sheets("Key").Cells(Rows.Count, "A").End(xlUp).Row
str = ran(a)
If InStr(str, "/") > 0 Then
Do While InStr(str, "/") > 0
d = Application.WorksheetFunction.Search("/", str)
st = Mid(str, 1, d - 1)
str = Application.WorksheetFunction.Clean(Trim(Mid(str, d + 1, Len(str))))
For c = 1 To b
If LCase(st) = LCase(Sheets("Key").Cells(c, "A").Value) Then
KeyVal = KeyVal + Sheets("Key").Cells(c, "B").Value
End If
Next
If InStr(str, "/") <= 0 Then
For c = 1 To b
If str = Sheets("Key").Cells(c, "A").Value Then
KeyVal = KeyVal + Sheets("Key").Cells(c, "B").Value
End If
Next
End If
Loop
Else
For c = 1 To b
If ran(a) = Sheets("Key").Cells(c, "A").Value Then
KeyVal = KeyVal + Sheets("Key").Cells(c, "B").Value
End If
Next
End If
a = a + 1
End If
Loop
End Function
Was sagt Ihnen das Durchlaufen des Codes im Debugger? Welche Codezeile verursacht den Absturz? Wir sind nicht hier, um das grundlegende Debugging Ihres Codes durchzuführen. Verfolgen Sie den Abschnitt des Codes, der das Problem verursacht, und dann können Sie das Problem klarer beschreiben und eine ** spezifische Frage * stellen, die wir beantworten können. –