VBA Autoshape help

[JohnnyTightlips]

Folks,

I'm not a VBA person, so i put the following scenario to the board for an answer. (I can't install the HTML maker sorry)

I have a range of cells: "FTE Range" If an individual cell within that range is populated with a number I would like to insert (or copy) an AutoShape into that cell (basically gives it a pretty border) To further help I include the code that I have attempted. (VBA gurus please don't laugh - I have pieced my knowledge from Help Files, Google and recording myself manually copying the shape to a populated cell! :wink: )

Sub ShapePopulate()

For Each Cell In Range("FTERange")
ActiveSheet.Shapes("AutoShape 4").Copy
If Value <> 0 Then ActiveSheet.Shapes("AutoShape 4").Paste
Next Cell
End Sub

There is a shape on the sheet called "Autoshape 4". When I manually recorded the Macro it referred to that shape

At the moment, the routine runs but nothing happens

Thanks in advance

 

[erik.van.geit]

Hi,

did you consider "Conditional Format", the "native" inbuilt-function, designed for this kinda situations

putting shapes in your sheet could be "heavy" on the long run ...

if you want anyway to use your code, try something like this

Sub ShapePopulate()
ActiveSheet.Shapes("AutoShape 4").Copy
For Each cell In Range("FTERange")
    With cell
        If .Value <> 0 Then
        .Select
        ActiveSheet.Paste
        End If
    End With
Next cell

kind regards,
Erik

 

[JohnnyTightlips]

Erik, thanks it worked once I changed .Paste to .PasteSpecial. For some reason the shapes were initially missing the target cells and pasting one row down and one column to the right. Now they are pasted as a Picture, which is suitable for my needs

I am using the shapes as it gives a three dimensional look to the cells and appears as a rectangle with curved corners. I don't believe that is inherent in Conditional (Or Excel in general) Formatting- I could be wrong though.


I will be updating the range periodically and will need to rerun the code that will delete shapes and repopulate the range. I had a go at creating a delete shapes Macro, but that deleted a whole lot of blank cells and didn't touch any of the shapes. Can anyone provide some advice?

Sub DeleteShapes()

For Each Shape In Range("FTERange")
With Shape
    .Delete
End With
Next Shape

End Sub

 

[erik.van.geit]

we could talk an hour about this
I hope you will take the time to understand what this is all about...
1. code
2. consequences of deleting all objects in a range ...
3. consequences of using shapes to "format" cells (indeed conditional format is only changing cellproperties-appearance)

CODE
you can name a variable "banana", but this doesn't mean that it IS a banana, you can call it workbook, while it is a cell

any item of a range is a range
any item of people is a human being

try this very bad code

Sub test()

For Each Workbook In Range("A1:A5")
MsgBox Workbook.Address
Next Workbook
End Sub

it is using a "reserved" word as a variable
the variable is not declared

this is "correct", but now you can see the lack of logic

Option Explicit

Sub test()
Dim Workbook As Range

For Each Workbook In Range("A1:A5")
MsgBox Workbook.Address
Next Workbook
End Sub

same problem with your code
I added the declaration

Option Explicit

Sub test()
Dim Shape As Range

For Each Shape In Range("A1:A5")
MsgBox Shape.Address
Next Shape
End Sub

avoid using terms like Object, Areas, Str, Filter, Title, Name, Item, Time, since they are used (needed) by VBA itself: that's why the first character changes in an uppercase automatically!


About "Item" (or "Name", "Time", ...)
click in that word within your code and press F1
the Help will appear on that item
sometimes this specific word is needed by VBA itself, that's why we don't use it

test this:
type: name = "excel"
pressing ENTER it will change in Name = "excel" (see the uppercase!)

you can do the same with item, ...

you see ?

From VBA Help on Visual Basic Naming Rules:

"Generally, you shouldn't use any names that are the same as the functions, statements, and methods in Visual Basic. You end up shadowing the same keywords in the language. To use an intrinsic language function, statement, or method that conflicts with an assigned name, you must explicitly identify it. Precede the intrinsic function, statement, or method name with the name of the associated type library. For example, if you have a variable called Left, you can only invoke the Left function using VBA.Left."

so this will be better

Sub test()
Dim sh As Shape

    For Each sh In ActiveSheet.Shapes
    MsgBox sh.TopLeftCell.Address, 64, sh.Name
    Next sh
End Sub

adapted to your purpose

Option Explicit

Sub test()
Dim sh As Shape

    For Each sh In ActiveSheet.Shapes
        With sh
        If Not Intersect(.TopLeftCell, Range("FTERange")) Is Nothing Then .Delete
        End With
    Next sh

End Sub

kind regards,
Erik

 

[erik.van.geit]

second item was
deleting all objects in a range ...
using the previously posted code is no problem as long as there are no comments nor validation on the sheet: removing validation is really the weirdest problem using that code

so better be sure and use something else
this is fine for the entire sheet: deletes all objects, but not the comments nor the validations

ActiveSheet.DrawingObjects.Delete

but it is not flexibel to delete shapes in a certain range
so we need more code

Option Explicit

Sub remove_objects()
'Erik Van Geit
'061012
'NOT deleted:
'validation dropdown
'comments

Dim obj As Object
Dim msg As String
Dim rng As Range

Set rng = Range("FTERange")

msg = "Are you sure you want to delete all shapes from the range " & rng.Address(0, 0) & "?" & vbLf & _
"(except validationdropdowns and comments)"
If MsgBox(msg, 36, "DELETE ALL OBJECTS") = vbNo Then Exit Sub

    For Each obj In ActiveSheet.Shapes
        With obj
            Select Case .Type
            Case 8
            On Error Resume Next
            'validation dropdown can not be selected
            .Select
                If Err Then
                Err.Clear
                Else
                If Not Intersect(.TopLeftCell, rng) Is Nothing Then .Delete
                End If
            Case 4
            'comments not deleted
            Case Else
            If Not Intersect(.TopLeftCell, rng) Is Nothing Then .Delete
            End Select
        End With
    Next obj

End Sub

third item:
consequences of using shapes to "format" cells
some things are more difficult to do: it's a maintenance matter: not a big deal if your sheet will stay rather "static" (no new rows or columns, no hiding, ...)
think about performance (speed) & filesize
having to run code just for formatting: when will you update ?
This last part just meant to warn you, not to make you afraid to be creative

 

[JohnnyTightlips]

Erik: Thanks for taking the time