VBA宏停止工作

时间:2014-02-06 09:58:18

标签: excel vba excel-vba

我有一段清除所选单元格的代码。

Private Sub CommandButton6_Click()
ThisWorkbook.Sheets("MoM-Log").Unprotect Password:="Password"
ThisWorkbook.Sheets("MoM-Template").Unprotect Password:="Password"
ThisWorkbook.Activate
Dim cell As Object
Dim count As Integer
For Each cell In selection
    cell.Clear
    With cell
        .BorderAround ColorIndex:=1, Weight:=xlThin
        .HorizontalAlignment = xlCenter
        If .Column = 3 Or .Column = 6 Then
            .HorizontalAlignment = xlLeft
        End If
         If .Column = 3 Or .Column = 4 Or .Column = 6 Then
            .WrapText = True
        End If
    End With
Next cell
ThisWorkbook.Sheets("MoM-Log").Protect Password:="Password"
ThisWorkbook.Sheets("MoM-Template").Protect Password:="Password"
End Sub

此代码工作正常。但是,一旦我添加了额外的代码,它就会停止工作。是的,

Sub DeletePopUpMenu()
  ' Delete the popup menu if it already exists.
  On Error Resume Next
  Application.CommandBars("MyPopUpMenu").Delete
  On Error GoTo 0
End Sub

Sub CreateDisplayPopUpMenu()
 ' Delete any existing popup menu.
  Windows(ThisWorkbook.Name).Activate
  Sheet1.Select
  Call DeletePopUpMenu

  ' Create the popup menu.
  Call Custom_PopUpMenu_1

 ' Display the popup menu.
  On Error Resume Next
  Application.CommandBars("MyPopUpMenu").ShowPopup
  On Error GoTo 0
End Sub

 Public Sub Custom_PopUpMenu_1()
  Dim MenuItem As CommandBarPopup
  ' Add the popup menu.
  With Application.CommandBars.Add(Name:="MyPopUpMenu", Position:=msoBarPopup, _
     MenuBar:=False, Temporary:=True)

    ' First, add two buttons to the menu.
    With .Controls.Add(Type:=msoControlButton)
        .Caption = "Save As..."
        .FaceId = 71
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
    End With
 End With
End Sub

 Public Function selection(R As Integer, st As String, y As Workbook) As Integer
    count_col = 1
    Do
        x = y.Sheets("Sheet1").Cells(R, count_col)
        If x = st Then ' St is a desired string
            Exit Do
        End If
        count_col = count_col + 1
    Loop While count_col <> 100
    selection = count_col
 End Function

所以请帮助我如何克服这一点。很快就要解决这个问题非常重要。

谢谢

2 个答案:

答案 0 :(得分:1)

  

是的,在调试模式下,它会出现以下错误:编译错误:参数在行中不可选,“For Each cell In selection” - user2148238 46分钟前

您收到该错误是因为选择不是有效的Range。必须发生的事情是,其他代码必须将选择移动到不是范围的其他内容。为确保您拥有有效范围,请使用TypeName,如下所示。

同时将Dim cell As Object更改为Dim cell As Range

Private Sub CommandButton6_Click()
    ThisWorkbook.Sheets("MoM-Log").Unprotect Password:="Password"
    ThisWorkbook.Sheets("MoM-Template").Unprotect Password:="Password"

    Dim cell As Range
    Dim count As Integer

    '~~> Check if what the user selected is a valid range
    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range first."
        Exit Sub
    End If

    For Each cell In Selection
        cell.Clear
        With cell
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .HorizontalAlignment = xlCenter

            If .Column = 3 Or .Column = 6 Then .HorizontalAlignment = xlLeft
            If .Column = 3 Or .Column = 4 Or .Column = 6 Then .WrapText = True
        End With
    Next cell

    ThisWorkbook.Sheets("MoM-Log").Protect Password:="Password"
    ThisWorkbook.Sheets("MoM-Template").Protect Password:="Password"
End Sub

答案 1 :(得分:0)

For Each cell In selection

行上方添加您的选择

例如

Sheets("Sheet1").Range("A1:F17").Select
For Each cell In selection