VBA刷新查询然后调整列宽

Question

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

我的问题是，在宏上执行完整操作时，要调整的列不会被调整。如果你走过去，效果很好。欢迎提出任何建议！

最终更新：这适用于零售家庭和商务版Excel。不在我当前使用的版本上。(这是微软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

Answer 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

让我知道它是否有效