CODEWITHSUNDEEP
excelexcel-2007vba
Mutuelinvestor
Mutuelinvestor

Reputation: 3538

Is it possible to dynamically control the location of a textbox in excel 2007

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.

enter image description here

Ultimately, I am attempting to do an excel version of the dashboard at the following link:

Link to Dashboard

Upvotes: 5

Views: 13869

Answers (3)

Alistair Weir
Alistair Weir

Reputation: 1849

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.

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

Upvotes: 1

Kazimierz Jawor
Kazimierz Jawor

Reputation: 19067

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.

Upvotes: 1

K_B
K_B

Reputation: 3678

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.

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.

So for my Shape named 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

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

Upvotes: 3

Related Questions