时间戳

首页 > 解决方案 > 这个使 excelsheet 如此缓慢的 vba 代码出了什么问题？

excel - 这个使 excelsheet 如此缓慢的 vba 代码出了什么问题？

问题描述

通过使用该站点上其他人提出的许多先前问题，我创建了一些对我来说非常有用的代码，只是我必须在其中出现问题，因为当我激活 vba 脚本时，excelsheet 尤其是脚本非常慢。

也许这是因为不同的子脚本？

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

标签： excelvba

解决方案

您可以尝试调用这些潜艇。先调用“SpeedupProcessing”，然后在所有处理完成后调用“Back_to_Normal”。

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

推荐阅读