VBA刷新查询然后调整列宽

Posted 2023-02-19

【中文标题】VBA刷新查询然后调整列宽

【英文标题】：VBA Refresh Queries Then Adjust Column Width

【发布时间】：2021-03-31 12:23:07

【问题描述】：

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

我的问题是在宏上执行完整运行时未调整列。如果你一步一步，它工作正常。任何建议表示赞赏！

最终更新：这适用于零售家庭和商业版的 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

【问题讨论】：

完全限定您的范围，而不是依赖“激活”。所以它应该是 "Worksheets("RMData").Columns("B:B").ColumnWidth = 41.57" 等。可以使用 'with' 语句进行清理，但我将把研究留给你.

@sous2817 这并没有解决我的问题。仍然让单元格看起来恢复到刷新希望它们的大小。

【参考方案1】：

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

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

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

让我知道它是否有效

【讨论】：

所以看起来它与其他答案完全相同。列由手动部分更改，然后在宏结束时强制刷新所需的内容。

您可以右键单击表格并在属性中取消选中调整列宽度

那已经被取消选中了。在 4 个选项中，我只有保留单元格格式