Pass Shapes property names into module

**rexwrx** · 05-06-2007, 08:52 PM

Hi all,

Ok, i'm not an expert at all with programming, so please bear with me:

This is a dashboard design.

In my spreadsheet I have (example) 4 drawings (shapes) -> they are all arrows.

I have a column called STATUS which basically has list of GREEN, AMBER, RED, which I can select. Whenever I select the GREEN/AMBER/RED, the drawing change from UP, DOWN or HORIZONTAL.

Each arrows will have its own status.

Example:
CEll - STATUS - ARROW
Cell $C$5 - RED - DOWN
Cell $C$16 - AMBER - HORIZONTAL

so I have this as the 'main' in my Sheet1:

Private Sub Worksheet_Change(ByVal Target1 As Excel.Range)

On Error GoTo WkSheet_Change_Err
    Dim trend As String
    
    'overall
    If (Target1.Address = "$C$5") Then

        Call changeTrend(Target1)
    
    End If
    
    'assets & liabilities
    If (Target1.Address = "$C$16") Then
        
        Call changeTrendAL(Target1)
    
    End If

......and so on

Each of the CALL will have this:

Sub changeTrend(ByVal Target1 As Excel.Range)

        trend = Target1.Value
        
        Select Case trend
        
            Case "G"
                ActiveSheet.shapes("AutoShape 10").Select
                Selection.ShapeRange.AutoShapeType = msoShapeUpArrow
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11 'green
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
            
            Case "R"
                ActiveSheet.shapes("AutoShape 10").Select
                Selection.ShapeRange.AutoShapeType = msoShapeDownArrow
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 'red
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                   
            Case "A"
                'ActiveSheet.shapes(myshape).Select
                ActiveSheet.shapes("AutoShape 10").Select
                Selection.ShapeRange.AutoShapeType = msoShapeLeftRightArrow
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 52 'orange
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
        End Select

End Sub

.....

and so on.

this is quite cumbersome and what I need is to PASS the name of the SHAPES as parameter into the MODULE - just like passing the 'TARGET'

Call changeTrend(Target1) ->.

QS:

HOW do I pass the name of the shapes as parameter???

Thanks

**Leith Ross** · 05-06-2007, 11:52 PM

Hello Rexwrx,

Wrap your code using the # tags or your post may get locked. The first thing to do is rename your arrows. This removes the code dependence of using the system name and having use that name in your code. Name them "Up Arrow", "Down Arrow", and "Horiz Arrow" instead of "AutoShape 10" etc. Select the shape and the name will appear in the Worksheet Name Box in the upper left corner. Click in the box, type the name you want, and hit the Enter key. Tour code can be shorten as well...

Private Sub Worksheet_Change(ByVal Target1 As Excel.Range)
 
  Dim trend As String
    On Error GoTo WkSheet_Change_Err

    'overall
     If (Target1.Address = "$C$5") Then
        Call changeTrend(Target1, "Down Arrow")
     End If

    'assets & liabilities
     If (Target1.Address = "$C$16") Then
        Call changeTrend(Target1, "Horiz Arrow")
     End If

Sub changeTrend(ByVal Target1 As Excel.Range, ShapeName As String)

  Dim ShapeColor As Long

    trend = Target1.Value

    Select Case trend
      Case "G"
        ShapeColor = 11   'green
      Case "R"
        ShapeColor = 10   'red
      Case "A"
        ShapeColor = 52   'orange
      Case Else
        Exit Sub
    End Select

    With ActiveSheet.Shapes(ShapeName)
      .Fill.BackColor.SchemeColor = ShapeColor
      .Visible = True
    End With

End Sub

Sincerely,
Leith Ross

**rexwrx** · 05-08-2007, 08:11 PM

Ok thanks for the two tips.

will give it a try.

actually i've got few sets of arrows, each set containing 'up', 'down', and 'horizontal'.

do i need unique names for each sets?

**rexwrx** · 05-08-2007, 08:24 PM

also i want say if Trend is "G", then i want the shape to be UP ARROW and colour to be GREEN.

if trend is "R" then, shape to be DOWN ARROW, and colour to be RED

if trend is "A" then, shape to be HORIZONTAL ARROW and colour AMBER.

 Select Case trend
      Case "G"
        ShapeColor = 11   'green
      Case "R"
        ShapeColor = 10   'red
      Case "A"
        ShapeColor = 52   'orange
      Case Else
        Exit Sub
    End Select

**rexwrx** · 05-08-2007, 08:47 PM

yay! this works also...

 Select Case trend
      Case "G"
        ShapeColor = 11   'green
        shapetype = msoShapeUpArrow
      Case "R"
        ShapeColor = 10   'red
        shapetype = msoShapeDownArrow
      Case "A"
        ShapeColor = 52   'orange
        shapetype = msoShapeLeftRightArrow
      Case Else
        Exit Sub
    End Select

    With ActiveSheet.shapes(Shapename)
      .Fill.ForeColor.SchemeColor = ShapeColor
      .AutoShapeType = shapetype
      .Visible = True
    End With

Pass Shapes property names into module

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Pass Shapes property names into module

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions