是否可以动态控制excel 2007中文本框的位置

时间:2013-03-19 13:39:09

标签: excel excel-vba excel-2007 vba

我在仪表板项目上工作,我将有三个值:最小值,最大值和当前值。最小值和最大值将是条形的终点,我想在条形图的适当位置放置一个包含当前值的文本框。见下文:

是否可以在Excel中执行此操作,如果是这样,我将如何实现此目的。我有一些Visual Basic的经验,但我之前没有遇到过这个。

enter image description here

最终,我试图在以下链接上执行仪表板的excel版本:

Link to Dashboard

3 个答案:

答案 0 :(得分:3)

未选择Shape对象时打开宏录制。现在选择它并改变它的位置。停止录制并使用生成的代码。

当我尝试它时,它看起来很有用。我有一些IncrementTop和IncrementLeft代码。您也可以直接使用Top和Left属性。

将Shape-object的名称更改为有意义的内容(在公式框左侧的地址框中)可能是一个想法,因此您的代码更具可读性。

因此我的Shape命名为PositionIndicator:

ActiveSheet.Shapes("PositionIndicator").Left = 250

ActiveSheet.Shapes("PositionIndicator").Left = _ 
    ActiveSheet.Shapes("PositionIndicator").Left + 5

要将其链接到单元格值,只需使用Range("CELLADDRESS").Value2

要在每次更改单元格值时应用它,请使用:

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
祝你好运

答案 1 :(得分:1)

我喜欢你的想法因此我检查了完整代码的样子。结果如下:

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

从即时窗口的事件调用该过程进行测试,例如:

SolutionShape 0.51      'go to beginning
SolutionShape 6.75      'go to end

此解决方案适用于放置形状的任何地方以及您设置的任何新尺寸。

答案 2 :(得分:1)

假设进度条是工作表上的形状(索引1),文本框是形状索引2;以下内容根据完成百分比沿着进度条移动文本框。

注意:必须调整它以偏移箭头左侧文本框形状的部分。

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