perhol
12-17-2019, 08:57 AM
Re-posting a question that never got an answer!
The following VBA code is created for Excel 2003.
It is ment to dele existing flags on Sheet1 and Sheet6 and put new flags in each cell where the text "* år" 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 CommandButton7 is placed on Sheet1 in one of the cells where the text "* year" occurs and the flags is positioned at the cell B36.
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 - All comments have been translated from Danish to English:
Sub SætFlag() 'Sub PlaceFlags
'Screen updating off
Application.ScreenUpdating = False
'Flag on sheet2 is copied
Ark2.Shapes("Billede 1").Copy
'The calendar sheets are designated
For Each sht In Array(Ark1, Ark6)
'Calendar sheets are unlocked
With sht
.Unprotect
'Existing flags on calendar sheets are deleted
For Each sh In .Shapes
If sh.Type = msoPicture Then
sh.Delete
End If
'Unlocking and deleting is repeated on the next calendar sheet
Next sh
'New flags are inserted at each birthday on calendar sheets
For Each c In .Range("D3:D33, 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
Ark2.Shapes("Billede 1").Copy
.Paste
'The location of the flags is determined to
'the top of the cell
'left side of cell + width of cell - width of flag
With .Shapes(.Shapes.Count)
.Top = c.Top
.Left = c.Left + c.Width - .Width
End With
End If
Next c
'Calendar sheets are locked again
.Protect
End With
'New flags are inserted on the next calendar sheet
Next sht
'Screen updating is turned on again
Application.ScreenUpdating = True
End Sub
The file is attached
The following VBA code is created for Excel 2003.
It is ment to dele existing flags on Sheet1 and Sheet6 and put new flags in each cell where the text "* år" 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 CommandButton7 is placed on Sheet1 in one of the cells where the text "* year" occurs and the flags is positioned at the cell B36.
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 - All comments have been translated from Danish to English:
Sub SætFlag() 'Sub PlaceFlags
'Screen updating off
Application.ScreenUpdating = False
'Flag on sheet2 is copied
Ark2.Shapes("Billede 1").Copy
'The calendar sheets are designated
For Each sht In Array(Ark1, Ark6)
'Calendar sheets are unlocked
With sht
.Unprotect
'Existing flags on calendar sheets are deleted
For Each sh In .Shapes
If sh.Type = msoPicture Then
sh.Delete
End If
'Unlocking and deleting is repeated on the next calendar sheet
Next sh
'New flags are inserted at each birthday on calendar sheets
For Each c In .Range("D3:D33, 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
Ark2.Shapes("Billede 1").Copy
.Paste
'The location of the flags is determined to
'the top of the cell
'left side of cell + width of cell - width of flag
With .Shapes(.Shapes.Count)
.Top = c.Top
.Left = c.Left + c.Width - .Width
End With
End If
Next c
'Calendar sheets are locked again
.Protect
End With
'New flags are inserted on the next calendar sheet
Next sht
'Screen updating is turned on again
Application.ScreenUpdating = True
End Sub
The file is attached