The following VBA code is created for Excel 2003.
It deletes existing flags on Sheet1 and Sheet6 and puts new flags in each cell where the text "* year" occurs.
The flag is positioned in the cell's upper right corner.
However, I have switched to Excel 2007, and here the code is not working as expected on Sheet1.
Instead CommandButton1 is placed on Sheet1 in the cell where the text "* year" occurs and the flag is positioned at the top left in cell L35.
If there are more birthdays, flags for these is positioned 1 flag-width to the right and 1 flag-height below previous flags.
On Sheet6 the code works as expected!
I can not figure out what is wrong.
Is there anyone who can help?
Here's the code:
[VBA]Sub SetFlag()
'Screen update is switched off
Application.ScreenUpdating = False
'Flag on Sheet2 is copied
Ark2.Shapes("Billede 1").Copy
'calendar sheets is identified
For Each sht In Array(Ark1, Ark6)
'calendar sheets is unlocked
With sht
.Unprotect
'Existing flags on the calendar sheets is deleted
For Each sh In .Shapes
If sh.Type = msoPicture Then
sh.Delete
End If
'Unlocking and deleting repeated on the next calendar sheet
Next sh
'New flag is added at each birthday on a calendar sheet
For Each c In .Range("D333, H3:H33, L3:L33, P3:P33, T3:T33, X3:X33, AB3:AB33, AF3:AF33, AJ3:AJ33, AN3:AN33, AR3:AR33, AV3:Av33")
If c.Value Like "*år.*" Then
.Paste
' The flag position is determined to
'top of the cell
'cell's left side + cell's width - width of the flag
With .Shapes(.Shapes.Count)
.Top = c.Top
.Left = c.Left + c.Width - .Width
End With
End If
Next c
'Calendar sheets locked again
.Protect
End With
'New flags added to next calendar sheet
Next sht
'Screen update turned on again
Application.ScreenUpdating = True
End Sub[/VBA]
Reply With Quote
