PDA

View Full Version : Solved: How did I screw up Johnske's routine to force macro enabling?



Gingertrees
11-04-2009, 03:32 PM
Aagghhh! This USED to show just "Prompt" sheet when user disables macros...now it can show "Hub" and "Cases" sheets (which I want only visible if macros Enabled).:banghead:

(Force macros routine courtesy johnske/KBase, http://vbaexpress.com/kb/getarticle.php?kb_id=578 )

NOTE: I think I probably screwed up in Private Sub UnhideSheets (near bottom), when I tried to change it to show "Hub and "Cases" instead of all sheets NOT "Prompt."

Please help:
' MODULE: ThisWorkbook
Option Explicit
'passwords for most sheets="cap", background="CAP", Cases="jaeger"

Dim bolMyOverride As Boolean

'// BeforeClose and Open remain as you had them, as do the proedures 'HideSheets' and //
'// 'UnhideSheets'. //
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call HideSheets
.ScreenUpdating = True
.EnableCancelKey = xlInterrupt
End With
End Sub

Private Sub Workbook_Open()
'this is located in the ThisWorkbook module
With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With

End Sub


Private Sub Workbook_Activate()

'// After you have run 'EnableStuffSoICanWork()', then the Boolean 'bolMyOverride' //
'// equals TRUE. //

'// So... assuming you've run the aforementioned sub and bolMyOverride has been set //
'// to True, the below test fails, and 'CutCopy_Disable' is never called. In short,//
'// as long as bolMyOverride retains a value of True, you can make mods w/o //
'// interference, as long as you don't reset. //
If Not bolMyOverride Then
'// Code moved to own sub //
Call CutCopy_Disable
End If
End Sub

Private Sub Workbook_Deactivate()

'// SAA //
If Not bolMyOverride Then
Call CutCopy_Enable
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If Not bolMyOverride Then
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End If

End Sub
Private Sub MakeBackgroundVisible()
Sheet16.Visible = xlSheetVisible
End Sub

Private Sub EnableStuffSoICanWork()
Call CutCopy_Enable
bolMyOverride = True
End Sub

Private Sub DisableStuffSoOthersCannotGooberUpMyDay()
Call CutCopy_Disable
bolMyOverride = False
'// Optional of course //
ThisWorkbook.Save
End Sub

Private Sub CutCopy_Disable()
Dim oCtrl As Office.CommandBarControl

'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl

'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl

Application.CellDragAndDrop = False
End Sub

Private Sub CutCopy_Enable()
Dim oCtrl As Office.CommandBarControl

'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl

'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl

Application.CellDragAndDrop = True
End Sub

Private Sub HideSheets()
'
Dim Sheet As Object '< Includes worksheets and chartsheets
'
With Sheets("Prompt")
'
'the hiding of the sheets constitutes a change that generates
'an automatic "Save?" prompt, so IF the book has already
'been saved prior to this point, the next line and the lines
'relating to .[A100] below bypass the "Save?" dialog...
' If ThisWorkbook.Saved = True Then .[A100] = "Saved"
'
.Visible = xlSheetVisible
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next
'
If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
End If
'
Set Sheet = Nothing
End With
'
End Sub

Private Sub UnhideSheets()
'
Dim Sheet As Object
'
With Sheets("Hub")
With Sheets("Cases")

.Visible = xlSheetVisible
Sheets("Prompt").Visible = xlSheetVeryHidden

For Each Sheet In Sheets
If Sheet.Name = "Hub" Then
Sheet.Visible = xlSheetVisible
Else
If Sheet.Name = "Cases" Then
Sheet.Visible = xlSheetVisible
Else
Sheet.Visible = xlSheetHidden
End If
End If
Next
End With
End With
'

'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
Set Sheet = Nothing
ActiveWorkbook.Saved = True


End Sub
'//this is the original "UnhideSheets" from johnske.
'//I copied and commented it when I modified "UnhideSheets"
'//as above.
'Private Sub UnhideSheets()
'
' Dim Sheet As Object
'
' For Each Sheet In Sheets
' If Not Sheet.Name = "Prompt" Then
' Sheet.Visible = xlSheetVisible
' End If
' Next
'
' Sheets("Prompt").Visible = xlSheetVeryHidden
'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
' Set Sheet = Nothing
' ActiveWorkbook.Saved = True

'End Sub

GTO
11-04-2009, 08:11 PM
Hi Ariel,

Not tested, try in a junk copy of your wb first:

Private Sub UnhideSheets()

With ThisWorkbook
.Worksheets("Hub").Visible = xlSheetVisible
.Worksheets("Cases").Visible = xlSheetVisible
.Worksheets("Prompt").Visible = xlSheetVeryHidden
.Saved = True
End With
End Sub


In short - we can skip the For Each looping, as we know we only want to display two sheets, and we know which ones these are.

I see that you were trying a nested With. In a blank/new wb, try this example:

Sub exa()
With Sheet1
.Range("A1:A4").Value = Application.Transpose(Array("Here", "is", "an", "example"))
With .Range("A1:A2")
.Font.Size = 12
.Interior.ColorIndex = 7
End With
With .Range("A3:A4")
With .Font
.Size = 14
.Bold = True
.ColorIndex = 3
End With
.Interior.ColorIndex = 15
End With
.Columns(1).EntireColumn.AutoFit
End With
End Sub


See, we are using the With to refer to an object (the sheet, a range, etc) and where we want to make changes to several things/properties that belong to the given object (such as the size, color, and bold of the .Font).

Where you are just changing one property (.Visible), With is not of benefit.

You'll see that I used one With, as each of the worksheets belongs to ThisWorkbook.

Hope that helps :-)

Mark

Gingertrees
11-05-2009, 07:03 AM
Thanks Mark, that seemed to do the trick. :-)