VBA 刷新查询然后调整列宽

问题描述

我试图在打开工作簿时运行一个代码，询问用户是否要刷新数据。如果是这样，那么它会刷新数据，然后将列调整为正确的大小（我不想自动调整）。

我的问题是在宏上完全运行时不会调整列。如果你通过，它工作正常。任何建议表示赞赏！

最终更新：这适用于零售家庭和商业版 Excel。不在我目前使用的版本上。 （这是 Microsoft Office Standard 2016。）这真是令人沮丧的启示！

Private Sub Workbook_open()
Dim Result
Result = MsgBox("The Data in this document might be outdated. Would you like to refresh the Data Queries? This process Could take a few minutes...",vbYesNo,"Data Query OutDated")
If Result = vbNo Then
Exit Sub
End If

MsgBox "Queries Will Refresh Upon Closing this window. Please wait."

Worksheets("sqlData").EnableCalculation = False
Worksheets("FlowBreakDown").EnableCalculation = False

ActiveWorkbook.RefreshAll

MsgBox "Refresh Complete"

Worksheets("RMData").Activate
    Columns("B:B").ColumnWidth = 41.57
    Columns("J:J").ColumnWidth = 26.14
    Columns("K:K").ColumnWidth = 14.57
    Columns("T:T").ColumnWidth = 14.57
Worksheets("PMData").Activate
    Columns("D:D").ColumnWidth = 12.86
    Columns("D:D").ColumnWidth = 10.14
    Columns("E:E").ColumnWidth = 9.43
    Columns("G:G").ColumnWidth = 16.57
    Columns("F:F").ColumnWidth = 37.42
    Columns("H:H").ColumnWidth = 8
    Columns("I:I").ColumnWidth = 8.43
    Columns("J:J").ColumnWidth = 10.57
    Columns("K:K").ColumnWidth = 12.29
    Columns("R:R").ColumnWidth = 12.29
    Columns("S:S").ColumnWidth = 10.29
    Columns("T:T").ColumnWidth = 18.14
End Sub

解决方法

我稍微重构了代码并禁用了后台的查询刷新

还添加了一些基本的错误处理

Private Sub Workbook_Open()

    ' Set basic error handling
    On Error GoTo CleanFail
    
    ' Turn off stuff
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("SQLData").EnableCalculation = False
    ThisWorkbook.Worksheets("FlowBreakDown").EnableCalculation = False
    
    ' Ask user to proceed with updating process
    Dim userAnswer As Long
    userAnswer = MsgBox("The Data in this document might be outdated." & Chr(13) & _
                        "Would you like to refresh the Data Queries?" & Chr(13) & _
                        "This process could take a few minutes...",vbYesNo,"Data Query OutDated")
    
    ' Exit sub if not
    If userAnswer = vbNo Then GoTo CleanExit
    
    MsgBox "Queries Will Refresh Upon Closing this window. Please wait."
    
    ' Change background refresh so process waits until all queries are done refreshing
    Change_Background_Refresh False
    
    ' Refresh all queries
    ThisWorkbook.RefreshAll
    
    ' Set columns widths
    With ThisWorkbook.Worksheets("RMData")
        .Columns("B:B").ColumnWidth = 41.57
        .Columns("J:J").ColumnWidth = 26.14
        .Columns("K:K").ColumnWidth = 14.57
        .Columns("T:T").ColumnWidth = 14.57
    End With

    With ThisWorkbook.Worksheets("PMData")
        .Columns("D:D").ColumnWidth = 12.86
        .Columns("D:D").ColumnWidth = 10.14
        .Columns("E:E").ColumnWidth = 9.43
        .Columns("G:G").ColumnWidth = 16.57
        .Columns("F:F").ColumnWidth = 37.42
        .Columns("H:H").ColumnWidth = 8
        .Columns("I:I").ColumnWidth = 8.43
        .Columns("J:J").ColumnWidth = 10.57
        .Columns("K:K").ColumnWidth = 12.29
        .Columns("R:R").ColumnWidth = 12.29
        .Columns("S:S").ColumnWidth = 10.29
        .Columns("T:T").ColumnWidth = 18.14
    End With
    
    MsgBox "Refresh Complete" & Chr(13) & _
            "Reenabling screenupdating and calculations..."
    
CleanExit:
    ' Turn on stuff again
    Change_Background_Refresh True
    Application.ScreenUpdating = True
    ThisWorkbook.Worksheets("SQLData").EnableCalculation = True
    ThisWorkbook.Worksheets("FlowBreakDown").EnableCalculation = True
    Exit Sub
    
CleanFail:
    MsgBox "An error occurred:" & Err.Description
    GoTo CleanExit
    
End Sub

Private Sub Change_Background_Refresh(ByVal enableBGRefresh As Boolean)
'Description: Enable or disable background refresh on all Power Query connections
'Author: Jon Acampora,Excel Campus
'Source:  https://www.excelcampus.com/library/enable-background-refresh-on-all-power-query-connections/
   
Dim lCnt As Long

    'The following code loops through all connections
    'in the active workbook.  Change the property to
    'True to Enable,False to Disable background refresh.
    
    With ThisWorkbook
        For lCnt = 1 To .Connections.Count
          'Excludes PowerPivot and other connections
          If .Connections(lCnt).Type = xlConnectionTypeOLEDB Then
            .Connections(lCnt).OLEDBConnection.BackgroundQuery = enableBGRefresh
          End If
        Next lCnt
    End With
    
End Sub

让我知道它是否有效