Question

我需要创建一个从MSSQL数据库更新数据的PowerPoint演示文稿。我在VBA模块中拥有所有代码，可以将文本更新到演示文稿中。但是当代码运行时，演示暂停和用户需要单击演示文稿以在更新完成后再次启动它。（在VBA代码运行时接收演示文稿暂停，并在用户单击演示文稿屏幕时重新启动）。这是一种避免这种情况的方法，以便在VBA模块运行时继续演示吗？

由于

Public Function SecondesAppelAgentsScores(Scope As String)
Dim c As ADODB.Connection, r As ADODB.Recordset
Dim s As String, t As String, i As Integer, l As String
Set c = New ADODB.Connection
Set r = New ADODB.Recordset
c.ConnectionString = "DSN=Gestcom"
c.Open
Select Case Scope
Case "Aujourdhui"
    l = "AjourdhuiStatistiquesAgent"
    s = "Select TOP 30 REPLACE(REPLACE(REPLACE(REPLACE(AgentName,'Scores', ''),'Mixte',''),'mxt',''),'_','') As Nom, AVG(DATEDIFF(second,CASE WHEN AnsweredTime IS NULL THEN DialTime ELSE AnsweredTime END, WrappedTime)) As MoyenneTempsAppels " & _
        "From SO_CallLogsExtendedByHour Where CampaignID In (Select Numero From SO_Campagnes Where Projet='Scores') And AgentName<>'' Group By AgentName Order By MoyenneTempsAppels;"
Case "Hier"
    l = "HierStatistiquesAgent"
    t = Format(Date - 1, "yyyy-mm-dd")
    s = "Select TOP 30 REPLACE(REPLACE(REPLACE(REPLACE(AgentName,'Scores', ''),'Mixte',''),'mxt',''),'_','') As Nom, AVG(DATEDIFF(second,CASE WHEN AnsweredTime IS NULL THEN DialTime ELSE AnsweredTime END, WrappedTime)) As MoyenneTempsAppels " & _
        "From SO_CallLogsExtended Where WkDate='" & t & "' And CampaignID In (Select Numero From SO_Campagnes Where Projet='Scores') And AgentName<>'' Group By AgentName Order By MoyenneTempsAppels;"
Case "MoisEnCours"
    l = "MoisStatistiquesAgent"
    t = Format(Date - 1, "yyyy-mm") & "-01"
    s = "Select TOP 30 REPLACE(REPLACE(REPLACE(REPLACE(AgentName,'Scores', ''),'Mixte',''),'mxt',''),'_','') As Nom, AVG(DATEDIFF(second,CASE WHEN AnsweredTime IS NULL THEN DialTime ELSE AnsweredTime END, WrappedTime)) As MoyenneTempsAppels " & _
        "From SO_CallLogsExtended Where WkDate>='" & t & "' And CampaignID In (Select Numero From SO_Campagnes Where Projet='Scores') And AgentName<>'' Group By AgentName Order By MoyenneTempsAppels;"
Case Else
    Set r = Nothing
    c.Close
    Set c = Nothing
    Exit Function
End Select
r.Open s, c, adOpenStatic
If Not (r.BOF And r.EOF) Then r.MoveFirst
i = 1
Do Until r.EOF
    ActivePresentation.Slides(4).Shapes(l & i).TextFrame.TextRange.Text = r.Fields(1) & " " & r.Fields(0)
    ActivePresentation.Slides(4).Shapes(l & i).TextFrame.TextRange.Words(1, 1).Font.Color = RGB(192, 0, 0)
    ActivePresentation.Slides(4).Shapes(l & i).TextFrame.TextRange.Words(2, 10).Font.Color = RGB(0, 0, 0)
    r.MoveNext
    i = i + 1
Loop
r.Close
Set r = Nothing
c.Close
Set c = Nothing
Do Until i > 30
    ActivePresentation.Slides(4).Shapes(l & i).TextFrame.TextRange.Text = ""
    i = i + 1
Loop
End Function

VBA代码运行时，Powerpoint presenation暂停

0 个答案: