使用Active X控制器运行时错误在另一个工作簿中运行另一个Active X控制器(Run time error using Active X controller to run another A

使用Active X控制器运行时错误在另一个工作簿中运行另一个Active X控制器(Run time error using Active X controller to run another Active X controller in another workbook)

我正在创建一个使用Active X控制器和来自另一个Active X控制器的调用来运行SQL查询的宏。 当我运行代码时，我不断收到一条错误消息，指出run time error 1004. Macro's may not be available in this workbook or may not be enabled. 我检查了宏是否已启用并且它们在所有工作表上都已启用。 我正在使用application.run方法来执行此操作。 除了未启用宏之外的任何其他原因？

以下是调用命令按钮的代码

做记录

此部分代码由另一名员工创建。 缺乏评论并不能反映我的一般编程标准。

Option Explicit Public Sub btnClear_Click() Call ClearReport ActiveSheet.Shapes.Range(Array("btnClear")).Select ActiveSheet.Shapes("btnRunReport").ScaleWidth 1, msoFalse, _ msoScaleFromTopLeft ActiveSheet.Shapes("btnClear").ScaleHeight 1, msoFalse, _ msoScaleFromTopLeft End Sub Public Sub btnRunReport_Click() Call RunReport ActiveSheet.Shapes.Range(Array("btnRunReport")).Select ActiveSheet.Shapes("btnRunReport").ScaleWidth 1, msoFalse, _ msoScaleFromTopLeft ActiveSheet.Shapes("btnRunReport").ScaleHeight 1, msoFalse, _ msoScaleFromTopLeft Columns("f:g").Select Selection.Style = "Comma" Rows("10:10").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("f:f").ColumnWidth = 10.71 Columns("g:g").ColumnWidth = 22.86 Range("A10").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(6, 7), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Columns("C:C").EntireColumn.AutoFit Range("c6").Select End Sub

Take Note

This section of code was created by another employee. The lack of commenting does not reflect my general programming standards.

Option Explicit Public Sub btnClear_Click() Call ClearReport ActiveSheet.Shapes.Range(Array("btnClear")).Select ActiveSheet.Shapes("btnRunReport").ScaleWidth 1, msoFalse, _ msoScaleFromTopLeft ActiveSheet.Shapes("btnClear").ScaleHeight 1, msoFalse, _ msoScaleFromTopLeft End Sub Public Sub btnRunReport_Click() Call RunReport ActiveSheet.Shapes.Range(Array("btnRunReport")).Select ActiveSheet.Shapes("btnRunReport").ScaleWidth 1, msoFalse, _ msoScaleFromTopLeft ActiveSheet.Shapes("btnRunReport").ScaleHeight 1, msoFalse, _ msoScaleFromTopLeft Columns("f:g").Select Selection.Style = "Comma" Rows("10:10").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("f:f").ColumnWidth = 10.71 Columns("g:g").ColumnWidth = 22.86 Range("A10").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(6, 7), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Columns("C:C").EntireColumn.AutoFit Range("c6").Select End Sub

Here is the code from the command button that is calling the other command button

Public Sub CommandButton1_Click() Dim Originalworkbook As Workbook Dim wkbSource As Workbook Dim wkbDest As Workbook Dim shttocopy As Worksheet Dim wbname As String Dim destSheet As Worksheet Dim LastRow As Long Application.ScreenUpdating = False ' check if the source file is open 'change this file path if customer information query is moved/changed name Ret = Isworkbookopen("\\showdog\service\\Test\CostBreakDownbyWorkOrder-Query.xlsm") If Ret = False Then ' if file is not open the open file 'change this file path if customer information query is moved/changed name Set wkbSource = Workbooks.Open("\\showdog\service\\Test\CostBreakDownbyWorkOrder-Query.xlsm") Else 'Just make it active 'if filename is changed then you must change the file name below to reflect the name change Set wkbSource = Workbooks("CostBreakDownbyWorkOrder-Query.xlsm") End If ' check if the destination file is open 'change this path if Service Jobs is moved/changed name Ret = Isworkbookopen("\\showdog\service\\Test\Pulled_Info.xlsm") If Ret = False Then ' if file is not open file 'change this path if Service Jobs is moved/changed name Set wkbDest = Workbooks.Open("\\showdog\service\\Test\Pulled_Info.xlsm") Set destSheet = wkbDest.Sheets("Pulled-Info.xlsm") 'clear contents of sheet destSheet.Cells.Delete 'run Sql in Cost break down workbook Application.Run "'CostBreakDownbyWorkOrder-Query.xlsm'!Sheet1.btnRunReport_Click" 'perform copy Set shttocopy = wkbSource.Sheets("Report") With shttocopy 'finds last row with information LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'copies cells with information regarding the customer information 'pastes those copied cells to the service jobs workbook on the customer information sheet 'resizes columns .Range("A10:J" & LastRow).Copy _ destSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1) destSheet.Cells.EntireColumn.AutoFit End With 'save and close file wkbDest.Save wkbDest.Close Else 'destination file is open 'Just make it active 'if filename is changed then you must change the file name below to reflect the name change Set wkbDest = Workbooks("Pulled_Info.xlsm") Set destSheet = wkbDest.Sheets("Pulled_Info") wkbDest.Activate 'clear contents of sheet destSheet.Cells.Delete 'run Sql in Cost break down workbook Application.Run "'CostBreakDownbyWorkOrder-Query.xlsm'!Sheet1.btnRunReport_Click" 'perform copy Set shttocopy = wkbSource.Sheets("Report") With shttocopy 'finds last row with information LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'copies cells with information regarding the customer information 'pastes those copied cells to the service jobs workbook on the customer information sheet 'resizes columns .Range("A10:J" & LastRow).Copy _ destSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1) destSheet.Cells.EntireColumn.AutoFit End With shttocopy.Activate wkbDest.Save End If Application.ScreenUpdating = True End Sub 'function to check if file is already open Function Isworkbookopen(filename As String) Dim ff As Long, ErrNo As Long Dim wkb As Workbook Dim nam As String wbname = filename On Error Resume Next ff = FreeFile() Open filename For Input Lock Read As #ff Close ff ErrNo = Err On Error GoTo 0 Select Case ErrNo Case 0: Isworkbookopen = False Case 70: Isworkbookopen = True Case Else: Error ErrNo End Select End Function

Any other relevant code may be provided upon request

最满意答案

我不得不重新安排application.run方法的位置。 在btnRunReport_click()调用的原始命令按钮btnRunReport_click()内部的代码。 需要处于活动状态的工作表在使用application.run方法的时间点处于活动状态。 下面发布的代码是按预期工作的。 感谢@Rory帮助推动我朝着正确的方向前进。

'Just make it active 'if filename is changed then you must change the file name below to reflect the name change Set wkbSource = Workbooks("CostBreakDownbyWorkOrder-Query.xlsm") End If 'run Sql in Cost break down workbook Application.Run "'CostBreakDownbyWorkOrder-Query.xlsm'!btnRunReport_Click"

与原始问题中发布的代码相比，您可以看到它最初所处的位置与现在的位置相比。

I had to rearrange where I had the application.run method. Code inside of the original command button btnRunReport_click() called upon activesheet. The sheet that needed to be active was not active at the point in time where the application.run method was being used. Posted below is the code that works as intended. Thank you to @Rory for the help in pushing me in the right direction.

'Just make it active 'if filename is changed then you must change the file name below to reflect the name change Set wkbSource = Workbooks("CostBreakDownbyWorkOrder-Query.xlsm") End If 'run Sql in Cost break down workbook Application.Run "'CostBreakDownbyWorkOrder-Query.xlsm'!btnRunReport_Click"

when compared to the code posted in the original question, you are able to see where it was originally located compared to where it is located now.