Results 1 to 7 of 7
  1. #1
    Lounger
    Join Date
    Apr 2001
    Location
    Sacramento, California, USA
    Posts
    30
    Thanks
    0
    Thanked 0 Times in 0 Posts

    cell location (2003)

    I'm attempting to create a matrix tool in excel whereby I replace numeric values in cells with formatted auto shapes.

    I know how to create auto shapes but I'm having difficulty positioning them in the right place.

    For example if cell contains a 1 and for every "1" in the sheet I want to draw a triangle, how does one determine specific position of that cell in order to feed it (or some derivation of it) in to the addshape method?

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: cell location (2003)

    A range object has properties Top, Left, Width and Height; you can use these in AddShape:

    Dim oCell As Range
    Set oCell = ActiveSheet.Cells.Find(What:=1, LookAt:=xlWhole)
    If Not oCell Is Nothing Then
    ActiveSheet.Shapes.AddShape msoShapeIsoscelesTriangle, _
    oCell.Top, oCell.Left, oCell.Width, oCell.Height
    End If

  3. #3
    Lounger
    Join Date
    Apr 2001
    Location
    Sacramento, California, USA
    Posts
    30
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: cell location (2003)

    Thanks for the reply. Somehow this works if I have a "1" in cell a1 but as soon as I add another 1 in cell b2 , for example, the drawing object seems to only be created once and not on either cell.
    I'll keep trying out diff options to see if i can get it to work.

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: cell location (2003)

    My reply was only meant to show how to determine the location of a cell. To place a shape over each cell with a 1, you need a loop:

    Sub PlacePictures()
    Dim oCell As Range
    Dim strFirstAddress As String
    With ActiveSheet.Cells
    Set oCell = .Find(What:=1, LookAt:=xlWhole)
    If Not oCell Is Nothing Then
    strFirstAddress = oCell.Address
    Do
    ActiveSheet.Shapes.AddShape msoShapeIsoscelesTriangle, _
    oCell.Left, oCell.Top, oCell.Width, oCell.Height
    Set oCell = .FindNext(oCell)
    Loop While Not oCell Is Nothing And Not oCell.Address = strFirstAddress
    End If
    End With
    End Sub

    BTW, in my original reply, I switched oCell.Left and oCell.Top by accident.

  5. #5
    Lounger
    Join Date
    Apr 2001
    Location
    Sacramento, California, USA
    Posts
    30
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: cell location (2003)

    I had nailed down the top / left thing after looking in help for the parameters again.
    - I have one final question.

    I've taken some of these ideas and have created a worksheet update funtion that will draw a shape based on the numeric value typed in to a cell.
    Now I'm wondering if there is a way to check to see if there is a shape already there and delete it if it exists before drawing a new one.

    Example,
    I type a 1 in a cell and I draw a box in the cell (via vba).
    Then, later, I type a 2 in the cell and want to draw a circle but - since there is already a square / box there, I'd want to delete the box first.

    Can't seem to find how to tell if a shape exists in a cell... at least it's not readily apparent.
    Thank you. Again.

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: cell location (2003)

    You could loop through the shapes on the sheet:

    Dim sh As Shape
    Dim oCell As Range

    Set oCell = ...

    For Each sh In ActiveSheet.Shapes
    With sh
    If .Left = oCell.Left And .Top = oCell.Top Then
    .Delete
    Exit For
    End If
    End With
    Next sh

  7. #7
    Lounger
    Join Date
    Apr 2001
    Location
    Sacramento, California, USA
    Posts
    30
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: cell location (2003)

    you're amazing. i think you might sleep even less than me.
    Thank you - I'll see if I can do something with this!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •