将基本形状左/右箭头添加为可单击的上一个/下一个按钮

For*_* Ed 3 excel vba

我正在看一些VBA代码,它将按选项卡的顺序将显示的工作表更改为上一个或下一个工作表。

我发现了这个stackoverflow问题,该问题涉及添加箭头,但它更像一个领导箭头(图中的红色)。

例子1

我想从插入功能区->插图部分->形状下拉菜单中添加左或右箭头:

例子2

我使用的代码的嗅探是:

Dim l As Long
Dim t As Long

l = Range("O3").Left
t = Range("Q3").Top

Item_Estimate_Sheet.Shapes.AddConnector(msoConnectorStraight, t + 89.25, l + 89.25, l, t).Select

With Selection
    With .ShapeRange.Line
        .EndArrowheadStyle = msoArrowheadOpen
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Weight = 1.5
    End With
End With
Run Code Online (Sandbox Code Playgroud)

我希望添加的是类似于我手动添加的以下内容:

例子3

B部分

避免使用选择。我一次又一次地听到要避免选择并且不需要选择。我尝试删除选择,当我这样做时,它导致了错误。在添加形状线的末尾似乎需要.something。有一个更好的方法吗?

C部分:除了在插入时记录宏之外,还有什么方法可以获取插入形状的尺寸/属性?(该死的我为什么不记得录制宏)

更新:

所以我记录了一个宏并按如下方式编辑了代码:

Item_Estimate_Sheet.Shapes.AddShape(msoShapeRightArrow, 859.5, 35.25, 25.5, 19.5).Select

With Selection
    With .ShapeRange.Line
        .Name = "NEXT"
        .Top = Range("S3").Top
        .Left = Range("S3").Left
        .Width = Range("Q3").Width * 2
        .Height = Range("Q3").Height * 2
    End With
End With
Run Code Online (Sandbox Code Playgroud)

当我摆脱选择如下时,它引发了一个错误..一些关于不可接受的方法:

With Item_Estimate_Sheet.Shapes.AddShape(msoShapeRightArrow, 859.5, 35.25, 25.5, 19.5)

    With .ShapeRange.Line
        .Name = "NEXT"
        .Top = Range("S3").Top
        .Left = Range("S3").Left
        .Width = Range("Q3").Width * 2
        .Height = Range("Q3").Height * 2
    End With
End With
Run Code Online (Sandbox Code Playgroud)

Jvd*_*vdV 5

我会提出来,但是我不确定对象的.Line属性到底是什么.ShapeRange目的。因此,我的想法是只插入一些箭头,将它们分配给a .Name.OnAction然后进一步将它们分组以分配更常见的属性,例如.Fill

显然,这只是草稿,但您也许能够了解它的完成方式(我认为)。

Sub InsertArrows()

Dim rngL As Range, rngR As Range
Dim shpL As Shape, shpR As Shape

For Each sht In ThisWorkbook.Sheets
    Set rngL = sht.Range("B2")
    Set rngR = sht.Range("C2")

    Set shpL = sht.Shapes.AddShape(msoShapeLeftArrow, rngL.Left, rngL.Top, rngL.Width, rngL.Height)
    With shpL
        .Name = "Last"
        .OnAction = "LastSheet"
    End With

    Set shpR = sht.Shapes.AddShape(msoShapeRightArrow, rngR.Left, rngR.Top, rngR.Width, rngR.Height)
    With shpR
        .Name = "Next"
        .OnAction = "NextSheet"
    End With

    Set shpRng = sht.Shapes.Range(Array("Last", "Next"))
    With shpRng
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        'More common properties.....
    End With
Next sht

End Sub

Sub LastSheet()
    'Some code to get to the last sheet 
End Sub

Sub NextSheet()
    'Some code to get to the next sheet 
End Sub
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明