Excel 2013不断崩溃

我的Excel VBA宏不断破坏Excel电子表格。这可能是因为我要求Excel发送多条短信/电子邮件，或者可能是我的

keyval

功能

---

Dim iMsg作为对象
作为对象的Dim-iConf
像弦一样暗的链子
作为变型的Dim FLD
将a变暗为整数
作为整数的Dim b
作为整数的Dim c
作为整数的Dim d
作为整数的Dim e
把它们调暗成线
暗线
作为字符串的Dim str
Dim em2作为字符串
将mon作为工作表
子单按钮事件（）
设置mon=工作表（“mon”）
st=“”
活动表。取消保护
如果ActiveSheet.Shapes（Application.Caller）.TopLeftCell.Row<30，则
a=ActiveSheet.Shapes（Application.Caller）.TopLeftCell.Row
如果单个单元格（a，“BB”）=”则
“MsgBox”BB列中没有数字。消息将不会发送”，vbCritical
出口接头
其他的
em=单个单元格（a，“BB”）.值
带单元格（a，“AV”）。字体
.Color=RGB（166、166、166）
.尺寸=12
以
呼叫发送短信
如果结束
其他的
对于b=1到29
如果单元格（b，“b”）为0，则
a=b
如果单个单元格（a，“BB”）=”则
其他的
em=单个单元格（a，“BB”）.值
呼叫发送短信
如果结束
如果结束
下一个
如果结束
保护工作表
端接头
子发送SMS（）
设置iMsg=CreateObject（“CDO.Message”）
设置iConf=CreateObject（“CDO.Configuration”）
iConf.Fields.Update
iMsg.To=em
'将下面的电子邮件更改为您的电子邮件
iMsg.From=”test@gmail.com"
iMsg.Subject=“”
c=单元格（a，“a”）。结束（xlToRight）。列
st=“”
em2=“”
如果c>2，则
'st=格式（日期，DDDD）&“
”
对于d=3到c
如果单元格（a，d）“”和CInt（单元格（30，d）.值）7，则
如果em2=“”，则
em2=单元格（30，d）.Value&“&Application.WorksheetFunction.Clean（单元格（a，d）.Value）&”&Application.WorksheetFunction.Clean（单元格（a，d+1）.Value）&“&Application.WorksheetFunction.Clean（单元格（a，d+2）.Value）&

d=d+2
其他的
em2=em2&Cells（30，d）.Value&“&Application.WorksheetFunction.Clean（Cells（a，d）.Value）&”&Application.WorksheetFunction.Clean（Cells（a，d）.Value）&“&Application.WorksheetFunction.Clean（Cells（a，d+2）.Value）&

d=d+2
如果结束
其他的
出口接头
如果结束
下一个
如果结束
'如果ActiveSheet.Name=“MON”，则
'str=单元格（a，“B”）。值
”“否则呢
'str=单元格（a，“B”）。值
"完"
如果em2=“”，则
iMsg.HTMLBody=st和“Visa triet”单元格（a，“AY”）。数值和“
总计”单元格（a，“B”）。数值和“
”
设置iMsg.Configuration=iConf
iMsg.发送
其他的
iMsg.HTMLBody=st
设置iMsg.Configuration=iConf
iMsg.发送
iMsg.HTMLBody=em2&“Visa”和单元格（a，“AY”）.值&“
总计”和单元格（a，“B”）.值&“
”
设置iMsg.Configuration=iConf
iMsg.发送
如果结束
设置iMsg=无
端接头
函数KeyVal（ParamArray ran（）作为变量）
应用程序。Volatile True
作为字符串的Dim str
a=0
当a0
d=应用程序.WorksheetFunction.Search（“/”，str）
st=Mid（str，1，d-1）
str=Application.WorksheetFunction.Clean（修剪（中间（str，d+1，Len（str）））
对于c=1到b
如果LCase（st）=LCase（表（“键”）.单元格（c，“A”）.值），则
KeyVal=KeyVal+图纸（“键”）。单元格（c，“B”）。值
如果结束
下一个
如果InStr（str，“/”使用CInt（ran）作为变量ran

将CDouble（keyval）用于keyval。
在调试器中单步执行代码会告诉您什么？哪一行代码导致了崩溃？我们不是来对代码进行基本调试的。追踪导致问题的代码部分，然后您将能够更清楚地描述问题，并提出我们可以尝试回答的特定问题。
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 = "test@gmail.com"
    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