Makro çalıştıktan sonra diğer makrolar donuyor

[sekozzy]

Arkadaşlar aşağıdaki makro ile mail gönderdikten sonra commandbar daki açılır menülere tıklanmıyor. Örneğin commandbar daki kenarlıklara tıkladığımda kenarlık eklemiyor seçmiyor. Ayrıca diğer makrolar da çalışmıyor. Nasıl çözebilirim?

Sub adrese_gonder()
Call Guncelle_Rapor

Dim adres As String, Subject As String, HTMLBody As String, BCC As String
Dim iMsg As Object, iConf As Object, Flds
Application.DisplayAlerts = False

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.yandex.com.tr"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "user@adres.com"
Flds.Item(schema & "sendpassword") = "sifre"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
yol = ActiveWorkbook.Path & "\mail1\"
    With iMsg
        .To = [I3]
        .CC = ""
        .BCC = ""
        .From = "Gönderici <user@adres.com>"
        .Subject = [I4]
        .HTMLBody = [I5]
        If [I6] <> "" Then .AddAttachment yol & [I6]
        If [I7] <> "" Then .AddAttachment yol & [I7]
        If [I8] <> "" Then .AddAttachment yol & [I8]
        If [I9] <> "" Then .AddAttachment yol & [I9]
        If [I10] <> "" Then .AddAttachment yol & [I10]
        If [I11] <> "" Then .AddAttachment yol & [I11]
        If [I12] <> "" Then .AddAttachment yol & [I12]
        If [I13] <> "" Then .AddAttachment yol & [I13]
        If [I14] <> "" Then .AddAttachment yol & [I14]
        If [I15] <> "" Then .AddAttachment yol & [I15]
        If [I16] <> "" Then .AddAttachment yol & [I16]
        .Sender = "Gönderici"
        .Organization = "Firma A.Ş."
        .ReplyTo = "user@mail.com"
    Set .Configuration = iConf
        SendEmail = .Send
        Application.DisplayAlerts = True
        MsgBox "E-posta ve dosyalar adrese gönderildi.   ", vbInformation, "www.adres.com"
    End With
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Sub

Sub Guncelle_Rapor()
    Dim Dosya As String, Klasor As String, i As Integer, Deg
    
   Set shliste = Sheets("LİSTE")
   sonsatir = shliste.Cells(Rows.Count, "B").End(3).Row
   kimerapor1 = ""
   kimerapor2 = ""
   kimerapor3 = ""
   For i = 1 To sonsatir
     grup = shliste.Cells(i, "F").Value
     mail = shliste.Cells(i, "E").Value
     If grup = "mail1" Then
       kimerapor1 = kimerapor1 & mail & "; "
     End If
     If grup = "mail2" Then
       kimerapor2 = kimerapor2 & mail & "; "
     End If
     If grup = "mail3" Then
       kimerapor3 = kimerapor3 & mail & "; "
     End If
   Next i
   [F3] = kimerapor1
   [I3] = kimerapor2
   [L3] = kimerapor3
   
'Dosya listesi güncelleniyor

    [F7:F16] = ""
    Klasor = ActiveWorkbook.Path & "\mail1\"
    Dosya = Dir(Klasor)
    Satir = 6
    While Dosya <> ""
        Satir = Satir + 1
        Cells(Satir, "F").Value = Dosya
        Dosya = Dir
        If Satir = 16 Then Dosya = ""
    Wend


    [I7:I16] = ""
    Klasor = ActiveWorkbook.Path & "\mail2\"
    Dosya = Dir(Klasor)
    Satir = 6
    While Dosya <> ""
        Satir = Satir + 1
        Cells(Satir, "I").Value = Dosya
        Dosya = Dir
        If Satir = 16 Then Dosya = ""
    Wend
    
End Sub

 

[sekozzy]

Sorunum halen devam ediyor. Mail gönderme makrosunu çalıştırdıktan sonra açılır menüler tıklanmıyor exceli kapatıp tekrar açınca düzeliyor.

Linkteki Resimde Görebilirsiniz.

 

[sekozzy]

Exceli kapatıp tekrar açtığımda sorun düzeliyor. En azından bu işlemi makro ile nasıl yapabilirim? Hiç olmazsa sorunu bu şekilde çözeyim...