vba 是否可以在excel 2007中动态控制文本框的位置
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15501106/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Is it possible to dynamically control the location of a textbox in excel 2007
提问by Mutuelinvestor
I working on a dashboard project where I will have three values: min value, max value and current value. The min and max values will be the end-points of a bar and I'd like to place a text box containing the current value at the appropriate location along the bar. See below:
我在一个仪表板项目中工作，我将拥有三个值：最小值、最大值和当前值。最小值和最大值将是条形的端点，我想在条形的适当位置放置一个包含当前值的文本框。见下文：
Is it possible to do this in Excel and if so, how would I go about achieving this. I have some experience with Visual Basic, but I haven't come across this one before.
是否可以在 Excel 中执行此操作，如果可以，我将如何实现这一目标。我有一些 Visual Basic 的经验，但我以前没有遇到过这个。
Ultimately, I am attempting to do an excel version of the dashboard at the following link:
最终，我试图在以下链接中制作仪表板的 excel 版本：
采纳答案by Kazimierz Jawor
I like your idea therefore I checked how could the complete code looks like. Here is the result:
我喜欢你的想法，因此我检查了完整代码的样子。结果如下：
Sub SolutionShape(currentVal)
Dim shpBar As Shape, shpCurrent As Shape
'let's assume we have only two shapes on the Activesheet
Set shpBar = ActiveSheet.Shapes(1)
Set shpCurrent = ActiveSheet.Shapes(2)
Dim barMin As Double, barMax As Double
barMin = 0.51 'both values could be taken from sheet
barMax = 6.75
'let's do it visualy complicated this time :)
With shpCurrent
.Left = (-.Width / 2 + shpBar.Left) + _
(((currentVal - barMin) / (barMax - barMin)) * shpBar.Width)
**'EDITED- adding information about current value:**
.TextFrame.Characters.Text = currentVal
End With
End Sub
Call the procedure from event of from immediate window for test, eg.:
从直接窗口的事件调用过程进行测试，例如：
SolutionShape 0.51 'go to beginning
SolutionShape 6.75 'go to end
This solution will work wherever you place shapes and whatever new dimensions of them you set.
此解决方案适用于您放置形状的任何地方以及您设置的任何新尺寸。
回答by K_B
Turn on the macro recording when the Shape-object is not selected. Now select it and change its position. Stop recording and use the code generated.
未选择形状对象时打开宏录制。现在选择它并改变它的位置。停止录制并使用生成的代码。
It looks useful to me when I tried it. I got some IncrementTop and IncrementLeft code. You can also use the Top and Left property directly.
当我尝试它时，它对我来说似乎很有用。我得到了一些 IncrementTop 和 IncrementLeft 代码。您也可以直接使用 Top 和 Left 属性。
It might be an idea to change the name of the Shape-object into something meaningful (in the address box left of the formula box) so your code gets more readable.
将 Shape 对象的名称更改为有意义的名称（在公式框左侧的地址框中）可能是一个想法，以便您的代码更具可读性。
So for my Shape named PositionIndicator:
所以对于我的名为 PositionIndicator 的形状：
ActiveSheet.Shapes("PositionIndicator").Left = 250
Or
或者
ActiveSheet.Shapes("PositionIndicator").Left = _
ActiveSheet.Shapes("PositionIndicator").Left + 5
To link it to a cell value just use Range("CELLADDRESS").Value2
要将其链接到单元格值，只需使用 Range("CELLADDRESS").Value2
To apply it every time you change the cells values use:
要在每次更改单元格值时应用它，请使用：
Private Sub Worksheet_Change(ByVal Target As Range)
'Here your script to check if the change concerns one of your input cells and then run the code to change the location of the Shape-object
End Sub
Good luck
祝你好运
回答by Alistair Weir
Assuming the progress bar is a shape on your worksheet (index 1) and textbox is shape index 2; the following moves the textbox along the progress bar based on the % complete.
假设进度条是工作表上的形状（索引 1），文本框是形状索引 2；以下基于完成百分比沿着进度条移动文本框。
Note: It will have to be adjusted to offset the portion of the textbox shape that is to the left of the arrow head.
注意：必须对其进行调整以偏移箭头左侧的文本框形状部分。
Option Explicit
Public Sub movebox()
Dim textbox As Shape, progbar As Shape
Dim ws As Worksheet
Dim stp As Integer, endp As Integer
Dim tbdyn As Integer
Dim mn As Double, mx As Double, actper As Double, cur As Double
Dim admn As Double, admx As Double
Set ws = Sheets("sheet1")
Set progbar = ws.Shapes(1)
Set textbox = ws.Shapes(2)
'// Far left of progress bar position
stp = progbar.Left
'// Far right of progress bar position
endp = (progbar.Width + stp)
'// Adjust for starting at 0.51
'// You could adjust mn,mx and cur to take the values
'// from the appropriate cells on the spreadsheet
mn = 0.51
mx = 6.07
admn = 0
admx = 6.07 - mn
cur = 4
'// Calculate percentage complete
actper = cur / admx
'// Apply percentage to progress bar
tbdyn = actper * endp
'// Move the textox appropriately
textbox.Left = tbdyn
End Sub
