在空格按钮上绘制边框vba excel

时间:2017-05-23 19:34:22

标签: vba draw

嗨,如果可能的话,我在VBA的新人需要一些帮助。我正在尝试制作3个按钮,每个按钮绘制一条顶线和一条底线(我也提供excel文件):

第一个按钮在顶部和底部的5行内部绘制。

第二个按钮在顶部和底部的10行内部绘制。

第三个按钮在顶部和底部的20行内部绘制。

我想要实现的目标: 每次我按下按钮1来保持计数,如果已经绘制了边框,如果我连续按两次按钮1以保持计数,如果我已经绘制了边框,并在保持两行之间的空间后再次绘制。 ...如果我按下Button1,然后按下按钮2或按钮3,则相同。

..我是VBA的新手,我很乐意帮助....

ub Macro2()
'
' Macro2 Macro
'

'
    Range("A13:BD23").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A27").Select
    ActiveWindow.SmallScroll Down:=12
    Range("A27").Select
End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A4:J8").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C9").Select
End Sub
Sub Macro3()
'
' Macro3 Macro
'

'
    Range("A26:P46").Select
    ActiveWindow.SmallScroll Down:=-6
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("G34").Select
    ActiveWindow.SmallScroll Down:=-15
End Sub

DL LINK: https://mega.nz/#!sgkVATKQ!k-Nq5gpKf4NfW2afEM8wpg_T5RFqT6y2_iqH7lDTM40

1 个答案:

答案 0 :(得分:0)

不确定我是否完全按照您的说明操作,但请尝试以下操作:

编辑 - 添加了重置“最后一个范围”的方法,以便重新开始。

Option Explicit

Sub DoFive()
    DoBorders Range("A4:J8")
End Sub

Sub DoTen()
    DoBorders Range("A13:BD23")
End Sub

Sub DoTwenty()
    DoBorders Range("A26:P46")
End Sub

'this is called to reset the starting point to whatever is passed.
Sub ResetStart()
    DoBorders Nothing
End Sub


Sub DoBorders(rng As Range)
    Dim useRange As Range
    Static lastRange As Range

    'handle resetting the "last range"
    If rng Is Nothing Then
        Set lastRange = Nothing
        Exit Sub
    End If

    If lastRange Is Nothing Then
        Set useRange = rng

    Else
        Set useRange = lastRange.Cells(1).Offset(lastRange.Rows.Count + 2, 0) _
                                   .Resize(rng.Rows.Count, rng.Columns.Count)
    End If

    Set lastRange = useRange 'save for next call

    With useRange
        .Borders.LineStyle = xlNone 'remove all borders
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
    End With

End Sub