这个使excelsheet这么慢的vba代码有什么问题呢？

Question

With the use of a lot of previous question from others on this site I create some code that works just great for me, only there must me something wrong in it because when i activate the vba script the excelsheet and especially the scripts is very slow.

Perhaps this is becasue of the different sub scripts?

Private Sub CommandButton1_Click()
    Dim OutlookApp As Object
    Dim Mess As Object, Recip, Datum, Aanhef, School, Leerlingen, Bezoekadres, Contact, Begintijd, Eindtijd
    Recip = [k10].Value
    n = SpinButton1.Value + 1
    Datum = Format(Cells(n, 2), "dddd d mmmm yyyy")
    Aanhef = Cells(n, 10)
    School = Cells(n, 3)
    Bezoekadres = Cells(n, 5)
    Contact = Cells(n, 6)
    Leerlingen = Cells(n, 12)
    Begintijd = Format(Cells(n, 7), "hh:mm")
    Eindtijd = Format(Cells(n, 8), "hh:mm")

    Set OutlookApp = CreateObject("Outlook.Application")
    Set Mess = OutlookApp.CreateItem(olMailItem)
    With Mess
        .Subject = "Afspraakherinnering op " & Datum & " op het " & School
        .HTMLBody = " Beste " & Aanhef "
        .To = Recip
        .Display
        '.send
    End With
End Sub

Private Sub CommandButton3_Click()
Dim objWorksheet As Excel.Worksheet
    Dim Mess As Object, Recip, Datum, Aanhef, School, Leerlingen, Bezoekadres, Contact, Begintijd, Eindtijd
    Dim objOutlookApp As Outlook.Application
    Dim objCalendar As Outlook.Folder
    Dim objSchoolEvent As Outlook.AppointmentItem
    Dim objRecurrencePattern As Outlook.RecurrencePattern
    n = SpinButton1.Value + 1

    Set objWorksheet = ThisWorkbook.Sheets(1)
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objCalendar = objOutlookApp.Session.GetDefaultFolder(olFolderCalendar)

        Set objSchoolEvent = objCalendar.Items.Add("IPM.Appointment")

        With objSchoolEvent
          .Subject = Cells(n, 3)
          .AllDayEvent = False
          .start = Cells(n, 2) + Cells(n, 7)
          .End = Cells(n, 2) + Cells(n, 8)
          .Location = Cells(n, 5)
          .Body = Cells(n, 14)
         .Save
        End With
End Sub

Private Sub SpinButton1_Change()
    n = SpinButton1.Value + 1
    Range("C38").Value = Cells(n, 3)
    Range("C39").Value = Format(Cells(n, 2), "dddd d mmmm yyyy")
    Range("C40").Value = Format(Cells(n, 7), "hh:mm")
    Range("C41").Value = Format(Cells(n, 8), "hh:mm")
End Sub
Private Sub CommandButton2_Click()
    Dim OutlookApp As Object
    Dim Mess As Object, Recip, Datum, Aanhef, School, Leerlingen, Bezoekadres, Contact, Begintijd, Eindtijd
    Recip = [k10].Value
    n = SpinButton1.Value + 1
    Datum = Format(Cells(n, 2), "dddd d mmmm yyyy")
    Aanhef = Cells(n, 10)
    School = Cells(n, 3)
    Bezoekadres = Cells(n, 5)
    Contact = Cells(n, 6)
    Leerlingen = Cells(n, 12)
    Begintijd = Format(Cells(n, 7), "hh:mm")
    Eindtijd = Format(Cells(n, 8), "hh:mm")

    Set OutlookApp = CreateObject("Outlook.Application")
    Set Mess = OutlookApp.CreateItem(olMailItem)
    With Mess
        .Subject = "Afspraakherinnering  op " & Datum & " op het " & School
        .HTMLBody = " Beste " & Aanhef & ",<br><br>"
        .To = Recip
        .Display
        '.send
    End With
End Sub

Answer 1

You could try calling these subs. Call "SpeedupProcessing" prior first and then call "Back_to_Normal" after all processing has been completed.

Sub Speedup_Processing()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub
Sub Back_To_Normal()
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   Application.EnableEvents = True
End Sub