Solved: Need to prevent save or close if msoShapeCross exists in specified sheet.

[frank_m]

Would it be complicated to prevent save or close if an msoShapeCross exists in specified sheet"

I wrote this to determine if a cross shape exist, but have no idea how to implement it in the before save and before close events.
[vba]Sheets("DATA").Select

For Each shp In ActiveSheet.Shapes

If shp.AutoShapeType = msoShapeCross Then
shp.TopLeftCell.EntireRow.Hidden = False
shp.TopLeftCell.Select
MsgBox "Cannot close or Save this workbook until the Cross shape has been clicked"
'The cross is tied to a macro where after the macro runs the cross is deleted
End If

Next[/vba] Thanks

[Bob Phillips]

[vba]

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If CheckShape Then Cancel = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If CheckShape Then Cancel = True
End Sub

Private Sub Workbook_Open()

End Sub

Private Function CheckShape() As Boolean
Dim shp As Shape

With Sheets("DATA")

For Each shp In .Shapes

If shp.AutoShapeType = msoShapeCross Then

shp.TopLeftCell.EntireRow.Hidden = False
.Activate
shp.TopLeftCell.Select
MsgBox "Cannot close or Save this workbook until the Cross shape has been clicked"
'The cross is tied to a macro where after the macro runs the cross is deleted
End If
Next
End With
End Function
[/vba]

This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

[frank_m]

HI Bob,

I appreciate the help. The code as is prevents saving, but does not prevent closing.
- When I attempt to close the file, I get my msgbox, then a dialog asking if I want to save the workbook, if I click yes I get my msgbox again, then it closes.

Sample workbook attached

Click the in or out buttons to create the the cross.
- Click the cross to delete it.

Thanks

[Bob Phillips]

I orgot the main bit in that code

[vba]

Private Function CheckShape() As Boolean
Dim shp As Shape

With Sheets("Tool_Log")

For Each shp In .Shapes

If shp.AutoShapeType = msoShapeCross Then

shp.TopLeftCell.EntireRow.Hidden = False
.Activate
shp.TopLeftCell.Select
MsgBox "Cannot close or Save this workbook until the Cross shape has been clicked"
'The cross is tied to a macro where after the macro runs the cross is deleted

CheckShape = True
Exit For
End If
Next
End With
End Function
[/vba]

[frank_m]

Awesome, works great now

Thank you much Bob