Excel VBA 按钮锚点
Excel VBA Button Anchor
我有多个按钮位于不同 table 的右侧,全部垂直堆叠。当我按下按钮时,它会在 table 的顶部添加一个新行并将其他行向下移动 - 这正是我想要的。然而,按钮似乎没有随着 table 的第一行移动,所以在每次点击几下之后,一切都错位了。我怎样才能让我的按钮固定在各自 tables.
的第一行
这是我的代码:
Private Sub CommandButton1_Click()
Dim mySheets
Dim i As Long
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("OP_DATE").EntireRow.Insert Shift:=xlDown
.Range("OP_DATE:lineOP").Borders.Weight = xlThin
End With
Next i
End Sub
Private Sub CommandButton2_Click()
Dim mySheets
Dim i As Long
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("P_DATE").EntireRow.Insert Shift:=xlDown
.Range("P_DATE:lineP").Borders.Weight = xlThin
End With
Next i
End Sub
Private Sub CommandButton3_Click()
Dim mySheets
Dim i As Long
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("S_DATE").EntireRow.Insert Shift:=xlDown
.Range("S_DATE:lineS").Borders.Weight = xlThin
End With
Next i
End Sub
您可能需要尝试一下,但应该非常接近。如果要添加多行,则需要将函数的 return 乘以该数字。
此函数获取以缇为单位的行高和列宽。
Public Function GetRowColumnTwips(r As Long, c As Long) As Variant
Dim twips(1) As Long
twips(0) = Rows(r).Height
twips(1) = Columns(c).Width 'I put this in if you need it but I'm not actually using it here
GetRowColumnTwips = twips
End Function
此子使用行高值来保持其在 sheet 上的位置。
Sub Button2_Click()
Dim twips As Variant
With Sheet1
twips = GetRowColumnTwips(.Shapes(Application.Caller).TopLeftCell.Row, .Shapes(Application.Caller).TopLeftCell.Column)
.Shapes(Application.Caller).Top = .Shapes(Application.Caller).Top - twips(0)
End With
End Sub
您可以将按钮事件子代码放入任何按钮代码中,唯一需要更改的是 With
语句中的 sheet。
在您的第一个按钮代码中:
Private Sub CommandButton1_Click()
Dim mySheets
Dim i As Long
Dim twips As Variant
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("OP_DATE").EntireRow.Insert Shift:=xlDown
.Range("OP_DATE:lineOP").Borders.Weight = xlThin
twips = Module1.GetRowColumnTwips(.Shapes(Application.Caller).TopLeftCell.Row, .Shapes(Application.Caller).TopLeftCell.Column)
.Shapes(Application.Caller).Top = .Shapes(Application.Caller).Top - twips(0)
End With
Next i
End Sub
对于 ActiveX 控件,您需要按名称引用每个按钮,而不是依赖于调用形状。
twips = Module1.GetRowColumnTwips(.OLEObjects("CommandButton1").TopLeftCell.Row, .OLEObjects("CommandButton1").TopLeftCell.Column)
.OLEObjects("CommandButton1").Top = .OLEObjects("CommandButton1").Top - twips(0)
我有多个按钮位于不同 table 的右侧,全部垂直堆叠。当我按下按钮时,它会在 table 的顶部添加一个新行并将其他行向下移动 - 这正是我想要的。然而,按钮似乎没有随着 table 的第一行移动,所以在每次点击几下之后,一切都错位了。我怎样才能让我的按钮固定在各自 tables.
的第一行这是我的代码:
Private Sub CommandButton1_Click()
Dim mySheets
Dim i As Long
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("OP_DATE").EntireRow.Insert Shift:=xlDown
.Range("OP_DATE:lineOP").Borders.Weight = xlThin
End With
Next i
End Sub
Private Sub CommandButton2_Click()
Dim mySheets
Dim i As Long
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("P_DATE").EntireRow.Insert Shift:=xlDown
.Range("P_DATE:lineP").Borders.Weight = xlThin
End With
Next i
End Sub
Private Sub CommandButton3_Click()
Dim mySheets
Dim i As Long
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("S_DATE").EntireRow.Insert Shift:=xlDown
.Range("S_DATE:lineS").Borders.Weight = xlThin
End With
Next i
End Sub
您可能需要尝试一下,但应该非常接近。如果要添加多行,则需要将函数的 return 乘以该数字。
此函数获取以缇为单位的行高和列宽。
Public Function GetRowColumnTwips(r As Long, c As Long) As Variant
Dim twips(1) As Long
twips(0) = Rows(r).Height
twips(1) = Columns(c).Width 'I put this in if you need it but I'm not actually using it here
GetRowColumnTwips = twips
End Function
此子使用行高值来保持其在 sheet 上的位置。
Sub Button2_Click()
Dim twips As Variant
With Sheet1
twips = GetRowColumnTwips(.Shapes(Application.Caller).TopLeftCell.Row, .Shapes(Application.Caller).TopLeftCell.Column)
.Shapes(Application.Caller).Top = .Shapes(Application.Caller).Top - twips(0)
End With
End Sub
您可以将按钮事件子代码放入任何按钮代码中,唯一需要更改的是 With
语句中的 sheet。
在您的第一个按钮代码中:
Private Sub CommandButton1_Click()
Dim mySheets
Dim i As Long
Dim twips As Variant
mySheets = Array("Highland")
For i = LBound(mySheets) To UBound(mySheets)
With Sheets(mySheets(i))
.Range("OP_DATE").EntireRow.Insert Shift:=xlDown
.Range("OP_DATE:lineOP").Borders.Weight = xlThin
twips = Module1.GetRowColumnTwips(.Shapes(Application.Caller).TopLeftCell.Row, .Shapes(Application.Caller).TopLeftCell.Column)
.Shapes(Application.Caller).Top = .Shapes(Application.Caller).Top - twips(0)
End With
Next i
End Sub
对于 ActiveX 控件,您需要按名称引用每个按钮,而不是依赖于调用形状。
twips = Module1.GetRowColumnTwips(.OLEObjects("CommandButton1").TopLeftCell.Row, .OLEObjects("CommandButton1").TopLeftCell.Column)
.OLEObjects("CommandButton1").Top = .OLEObjects("CommandButton1").Top - twips(0)