5

我在一个仪表板项目中工作，我将拥有三个值：最小值、最大值和当前值。最小值和最大值将是条的端点，我想在条的适当位置放置一个包含当前值的文本框。见下文：

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

在此处输入图像描述

最终，我尝试在以下链接中制作仪表板的 excel 版本：

链接到仪表板

4

3 回答 3

3

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

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

将 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

祝你好运

于 2013-03-19T13:58:45.920 回答
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

无论您放置形状以及设置的任何新尺寸，此解决方案都适用。

于 2013-03-19T14:11:38.430 回答
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
于 2013-03-19T14:13:59.070 回答