View Full Version : Solved: Need to prevent save or close if msoShapeCross exists in specified sheet.
frank_m
03-07-2011, 09:54 AM
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.
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 Thanks
Bob Phillips
03-07-2011, 11:29 AM
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
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
03-07-2011, 06:48 PM
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
03-08-2011, 12:56 AM
I orgot the main bit in that code
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
frank_m
03-08-2011, 01:24 AM
Awesome, works great now :thumb
Thank you much Bob
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.