VBA Autoshape help

JohnnyTightlips

Board Regular
Joined
Aug 13, 2006
Messages
94
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: )

Code:
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
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
Code:
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

Board Regular
Joined
Aug 13, 2006
Messages
94
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?


Code:
Sub DeleteShapes()

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

End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
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
Code:
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
Code:
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
Code:
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
Code:
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
Code:
ActiveSheet.DrawingObjects.Delete

but it is not flexibel to delete shapes in a certain range
so we need more code
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 :)
 

Forum statistics

Threads
1,136,992
Messages
5,679,018
Members
419,799
Latest member
APInfa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top