运行VBA加载项时出错

时间:2016-07-05 12:41:55

标签: excel vba excel-vba macros excel-addins

我正在Excel 2010中的.xlam文件中编写VBA宏。

当我尝试运行它时,我收到此错误:

  

对象变量或未设置块变量

它应该在特定的表中交换列,当我将它作为一个宏(不在加载项中)运行时,它完美地工作。 这是我的宏:

Sub SwapTable(ByVal control As IRibbonControl)
Dim LastCol As Long
Dim LastRow As Long
Dim Swaps As Long
Dim i As Integer
Dim DocumentTitle As String
Dim SearchDetails As String

LastRow = LastRowInOneColumn()
LastCol = LastColumnInOneRow(LastRow)
StartTitlesRow = Find_TitlesRow()
'copy title rows
With ActiveSheet
    DocumentTitle = .Cells(StartTitlesRow - 3, 1).Value
    SearchDetails = .Cells(StartTitlesRow - 2, 1).Value
End With

'check how many swaps needed
If LastCol Mod 2 = 0 Then
    Swaps = LastCol / 2
Else
    Swaps = (LastCol - 1) / 2
End If

'run swap
For i = 1 To Swaps
   Call Swap(i, LastCol - i + 1, LastRow, StartTitlesRow - 1)
Next i

'past title rows
With ActiveSheet
    .Cells(StartTitlesRow - 3, 1) = DocumentTitle
    .Cells(StartTitlesRow - 2, 1) = SearchDetails
End With
Worksheets(1).Columns("A:EE").AutoFit
End Sub



Function LastColumnInOneRow(LastRow As Long) As Long
'Find the last used row in a Column: column A in this example
Dim LastCol As Long
With ActiveSheet
        LastCol = .Cells(LastRow, .Columns.Count).End(xlToLeft).Column
End With
LastColumnInOneRow = LastCol
End Function

Function LastRowInOneColumn() As Long
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
LastRowInOneColumn = LastRow
End Function


Function Find_TitlesRow() As Long

Dim SearchString As String
Dim StartTitlesRow As Long

SearchString = "ùåøä"

With ActiveSheet
    Set cl = .Cells.Find(What:=SearchString, _
        After:=.Cells(1, 1), _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)

        If Not cl Is Nothing Then
            StartTitlesRow = cl.Row
        Else
            MsgBox "Could'nt find start row"
        End If
End With

Find_TitlesRow = StartTitlesRow
End Function


Function Swap(Col1 As Integer, Col2 As Integer, LastRow As Long,     StartTableRow As Variant)
Dim FirstCol As Variant
Dim SecondCol As Variant
Dim temp As Variant

    temp = Sheets(1).Range(Cells(StartTableRow, Col1), Cells(LastRow, Col1)).Value
    Sheets(1).Range(Cells(StartTableRow, Col1), Cells(LastRow, Col1)).Value = Sheets(1).Range(Cells(StartTableRow, Col2), Cells(LastRow, Col2)).Value
    Sheets(1).Range(Cells(StartTableRow, Col2), Cells(LastRow, Col2)).Value = temp

End Function

1 个答案:

答案 0 :(得分:2)

避免使用ActiveSheet!它只会给你一个问题,就像你所拥有的那样,你不确定它引用哪个表格。出于同样的原因,请避免ActiveWorkbook。{/ p>

而是获取对您要使用的工作表的引用:

Dim oWb As Workbook
Dim oSheet As Worksheet

Set oWb = Workbooks("[WORKBOOKNAME]")
'***** or use index like Workbooks(1)

If Not oWb Is Nothing Then
    Set oSheet = oWb.Sheets("[WORKSHEETNAME]")
    '***** or use index like Sheets(1)
End If

If Not oSheet Is Nothing Then
    '***** Do your stuff

    'past title rows
    With oSheet
        .Cells(StartTitlesRow - 3, 1) = DocumentTitle
        .Cells(StartTitlesRow - 2, 1) = SearchDetails
    End With

    '***** etc

End If

或者你可以像某些地方一样使用索引,但是你也需要指定一个工作簿,以避免使用ActiveWorkbook:

oWb.Worksheets(1).Columns("A:EE").AutoFit