如何将形状链接到列上, 以便当形状变大时, 列也会变大?
原标题：How to link a shape to a column so when the shape gets larger the column get larger too?
I want to do a database on Excel and in the first page there is a navigation menu on the left side working with macros for each tab to send the user to this exact tab. The code is the following and works.
Sub menuNav()
Dim menu As String
menu = Right(Application.Caller, Len(Application.Caller) - Len(Left(Application.Caller, 4)))
MsgBox menu
Application.Sheets(menu).Select
ActiveSheet.Range("C1").Select
End Sub
I would also like to make the menu workable, so if the user click on a button, the menu is slim and only show the icons for each tab, however, if the button is clicked again, the menu get larger and shows both the icons and the texts. I found a way with this code from this video : https://youtu.be/T6pRSAZXKpQ?si=J-cphOCsxDux8VZ-
Option Explicit
Dim P1 As Worksheet
Dim xMenu As ShapeRange
Dim i As Double
Dim x1 As ShapeRange
Dim x2 As ShapeRange
Dim x3 As ShapeRange
Dim x As Double
Dim y1Top As Double
Dim y3Top As Double
Dim l As Double
Dim btA As ShapeRange
Dim btD As ShapeRange
Private Sub CreateObjects()
Set P1 = ActiveSheet
Set xMenu = P1.Shapes.Range("MenuPlan")
Set x1 = P1.Shapes.Range("r1")
Set x2 = P1.Shapes.Range("r2")
Set x3 = P1.Shapes.Range("r3")
Set btA = P1.Shapes.Range("btAugmenter")
Set btD = P1.Shapes.Range("btDiminuer")
End Sub
Sub IncreaseEffects()
Call CreateObjects
btA.Visible = msoFalse
btD.Visible = msoCTrue
x = x1.Left
For i = 48 To 35 Step -0.4
DoEvents
xMenu.Width = i
x1.Left = x - 0.4
x2.Left = x - 0.4
x3.Left = x - 0.4
x = x - 0.4
Next i
P1.Shapes("txt_Page d accueil").TextFrame2.TextRange.Font.Fill.Visible = msoTrue
x = x1.Left
l = 19
For i = 35 To 170 Step 20
DoEvents
xMenu.Width = i
x1.Left = x + 20
x2.Left = x + 20
x3.Left = x + 20
x = x + 20
x2.Width = l
l = l - 3.3
x1.Rotation = 135
x3.Rotation = -135
Next i
y1Top = x1.Top + 6.1222
y3Top = x3.Top - 5.69032
x1.Top = y1Top
x3.Top = y3Top
x = x1.Left
For i = 170 To 180 Step 0.3
DoEvents
xMenu.Width = i
x1.Left = x + 0.3
x2.Left = x + 0.3
x3.Left = x + 0.3
x = x + 0.3
Next i
End Sub
Sub ReduceEffects()
Call CreateObjects
btA.Visible = msoCTrue
btD.Visible = msoFalse
x = x1.Left
For i = 180 To 193 Step 0.3
DoEvents
xMenu.Width = i
x1.Left = x + 0.3
x2.Left = x + 0.3
x3.Left = x + 0.3
x = x + 0.3
Next i
P1.Shapes("txt_Page d accueil").TextFrame2.TextRange.Font.Fill.Visible = msoFalse
x = x1.Left
l = 0
y1Top = x1.Top - 6.1222
y3Top = x3.Top + 5.69032
x1.Top = y1Top
x3.Top = y3Top
For i = 193 To 58 Step -20
DoEvents
xMenu.Width = i
x1.Left = x - 20
x2.Left = x - 20
x3.Left = x - 20
x = x - 20
x2.Width = l
l = l + 3.3
x1.Rotation = 0
x3.Rotation = 0
Next i
x = x1.Left
For i = 58 To 48 Step -0.3
DoEvents
xMenu.Width = i
x1.Left = x - 0.3
x2.Left = x - 0.3
x3.Left = x - 0.3
x = x - 0.3
Next i
End Sub
Now, in order for my project to work, I would like the navigation menu to be linked or be part of a column, so when the menu change size, the other columns don t get impacted from it.
问题回答
I didn t follow all the code you gave, just the basic idea (and I don t like the code, but this is StackOverflow, not CodeReview).
Assuming that your "menu" shape starts at the very left of the sheet (.left = 0), all you need to do is to adjust the column width of the first column (=A) so that it gets the same width as the menu shape.
Unfortunately, it is not so easy so set the exact width of a column - that s because the column width can be changed only using the property ColumnWidth which uses a different unit than Width.
Easiest way is to figure out the correct column width for the small and the large menu. For your large menu width (180), that s approx. 33.5, and for the small width, it s approx 8.5.
So add the statements
Sub ReduceEffects()
...
P1.Cells(1, 1).EntireColumn.ColumnWidth = 8.5
End Sub
Sub IncreaseEffects()
...
P1.Cells(1, 1).EntireColumn.ColumnWidth = 33.5
End Sub
But those values might be wrong - either play with them or use a function that tries to set the columnWidth property according to the width property of the menu shape. However, that s not that easy. I tried it by calculating the ratio between the ColumnWidth and the Width of a cell and use that to calculate the columnWidth from the menu width, but that s not working precisely. According to This answer on SO, you need to do this three times until it s precise enough.
Sub setMenuCellWidth()
Dim i As Long
With P1.Cells(1, 1).EntireColumn
For i = 1 To 3
Dim f As Double
f = .ColumnWidth / .Width
.ColumnWidth = xMenu.Width * f
Next
End With
End Sub
Now your code will be
Sub ReduceEffects()
...
setMenuCellWidth
End Sub
Sub IncreaseEffects()
...
setMenuCellWidth
End Sub
