如果列A中有值,则插入表单按钮

时间:2018-04-10 16:18:01

标签: vba excel-vba excel

我编写了一个程序,它自动在N列中插入表单按钮,直到最后一行包含数据。我试图让这个程序只在A列中有一个值(非空)时才插入一个按钮,但是我无法弄清楚这一点。我已经厌倦了多个if语句,但没有一个有效。

到目前为止,这是我的代码:

Sub InsertButtons()
Dim i As Long
Dim shp As Object
Dim dblLeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHeight As Double


With Sheets("MailMerge")
    dblLeft = .Columns("N:N").Left
    dblWidth = .Columns("N:N").Width
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        dblHeight = .Rows(i).Height
        dblTop = .Rows(i).Top
        Set shp = .Buttons.Add(dblLeft, dblTop, dblWidth, dblHeight)
        shp.OnAction = "SendEmail"
        shp.Characters.Text = "Email"
    Next i
End With

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

谢谢

2 个答案:

答案 0 :(得分:0)

这是你的解决方案......

你忘了" Dot"放在for循环声明中的单元格之前

    Sub InsertButtons()
    Dim i As Long
    Dim shp As Object
    Dim dblLeft As Double
    Dim dblTop As Double
    Dim dblWidth As Double
    Dim dblHeight As Double


    With Sheets("MailMerge")

        dblLeft = .Columns("N:N").Left
        dblWidth = .Columns("N:N").Width

        For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 'you have mistaked here
            dblHeight = .Rows(i).Height
            dblTop = .Rows(i).Top

            If .Cells(i, 1).value = Empty Then 'this is the if strucure

            Else

                Set shp = .Buttons.Add(dblLeft, dblTop, dblWidth, dblHeight)
                shp.OnAction = "SendEmail"
                shp.Characters.Text = "Email"

            End If

        Next i

    End With

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    End Sub

Result

答案 1 :(得分:0)

Sub InsertButtons()

Dim wb as Workbook
Dim ws as Worksheet
Dim c as Range, rng as Range
Dim lastRow as Long, n as Long
Dim arrMailList as Variant
Dim cmdButton as Button

Application.ScreenUpdating = False

Set wb = ThisWorkbook

On Error Goto EH1:

Set ws = wb.Worksheets("MailMerge")

With ws

    'This will erase all the worksheet buttons first
    .Buttons.Delete

    lastRow = .Cells(.Rows.Count,1).End(xlUp).Row        
    Set rng = .Range(.Cells(1, 1), .Cells(lastRow, 1))
End With

arrMailList = rng

    On Error Goto EH2:

    'Add a Button if there is a name in Column "A"
    For n = Lbound(arrMailList) to Ubound(arrMailList)

        If Not IsEmpty(arrMailList, 1)) Then

            With rng

                'Change Column Number for Button and Column Width to suit
                'I just picked Column E and set the Width to 20
                .Offset (0, 5).ColumnWidth = 20

                Set c = .Cells(n).Offset(0 ,5)

                    With c
                        Set cmdButton = ws.Buttons.Add(Left:= .Left, _
                        Top:= .Top, Width:= .Width, Height:= .Height)

                        With cmdButton

                            'adds the person's name to the button caption
                            .Caption = "Email " & arrMailList(n, 1)
                            .OnAction = "SendEmail"
                        End With
                    End With
                End With
        End If
Next n

Application.ScreenUpdating = True

Exit Sub

EH1:

    MsgBox "Please add the MailMerge worksheet before running this code!"

Exit Sub

EH2:

    MsgBox "No Names in Mail List!"

End Sub