Macro Security

[bear]

Hello,

I need help for this,

i want people whose macro security that is set to middle, cannot open the file. The application will auto close the window/application.

I tot of using msoAutomationSecurityLow. But i do not know how to use it. Please help me!


Thanks and appreciated.

[Bob Phillips]

Why would you want to do that?

[Simon Lloyd]

Bear, altering someones security settings without their knowledge or by code is classed as "Virus" activity, this type question is against this and many other forums rules!, a user has the right to select whichever type of security they think meets their needs and if that means preventing your code running automatically upon the workbook open then thats their choice!

[Ken Puls]

A question here...

Are you trying to force the users to enable macros because your workbook needs them to run? If so, you could check this KB entry:

Force User to Enable Macros

NOTE: I've unlocked this thread until we hear the answer for the intent.

[bear]

Thanks ken this is exactly what i want. i will try it out.

to xld and simon..sorry i dont know it is not correct to do so.
This is one of my school project.

[bear]

i got a question here



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


if i dont want it to auto save, do i remove



If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
End If

[Ken Puls]

Yes.

[Simon Lloyd]

Thanks ken this is exactly what i want. i will try it out.

to xld and simon..sorry i dont know it is not correct to do so.
This is one of my school project.You can view our policies on how we conduct the forum here (http://www.vbaexpress.com/forum/faq.php?) we have a particular policy around school work here (http://www.vbaexpress.com/forum/faq.php?faq=psting_faq_item#faq_hom_faq_item)

[bear]

Noted!

Ken, i got a question for you.
After i save my work and before i close the file, why did they prompt me and ask if i want to save my work?

[Bob Phillips]

Sounds as though you have some formula that is causing a recalculation, maybe =NOW() somewhere.

[bear]

There is no =NOW() somewhere.
I can show you my code..



Option Explicit

Private Sub Workbook_Open()

With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False

Call UnhideSheets

.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With

Application.Visible = True
If Application.Workbooks.Count > 1 Then
With CreateObject("Excel.Application")
.Visible = True
.DisplayAlerts = False
.Workbooks.Open ThisWorkbook.FullName, , True
.ActiveWorkbook.RunAutoMacros xlAutoOpen
End With
ThisWorkbook.Close False
End If

If ActiveWorkbook.Name = "Monthly Accounts Portfolio_123.xls" Then
DisableCutAndPaste
Else:
Call EnableCutAndPaste
End If
End Sub
'
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
Set Sheet = Nothing
ActiveWorkbook.Saved = True

End Sub

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 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
Sub DisableCutAndPaste()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
EnableControl 2521, False ' print
EnableControl 109, False ' print preview
EnableControl 4, False ' print...
EnableControl 3, False ' save
EnableControl 748, False ' saveas...
EnableControl 247, False ' pagesetup...
EnableControl 3823, False ' save as webpage
EnableControl 3655, False ' webpage preview
EnableControl 848, False ' move or copy sheet
EnableControl 846, False ' save workspace
EnableControl 30255, False ' print area
EnableControl 30095, False ' send to
EnableControl 762, False ' header & footer
EnableControl 30017, False 'macro
EnableControl 3738, False 'mail recipient

Application.OnKey "^s", ""
Application.OnKey "^c", ""
Application.OnKey "^p", ""
Application.OnKey "^w", ""
Application.OnKey "^v", ""
Application.OnKey "^+{F11}", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False

Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(Id:=847)
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(Id:=889)
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(Id:=748)
Ctrl.Enabled = False
Next Ctrl


' MenuBars(xlWorksheet).Menus("File").MenuItems("Save as Web Page...").Delete
' MenuBars(xlWorksheet).Menus("File").MenuItems("Save Workspace...").Delete
' MenuBars(xlWorksheet).Menus("File").MenuItems("Send To").Delete
' MenuBars(xlWorksheet).Menus("File").MenuItems("Web Page Preview").Delete

End Sub
Sub EnableControl(Id As Integer, Enabled As Boolean)
Dim CB As CommandBar
Dim C As CommandBarControl
Dim mb As MenuItems

For Each CB In Application.CommandBars
Set C = CB.FindControl(Id:=Id, recursive:=True)
If Not C Is Nothing Then C.Enabled = Enabled ' For Each mb In Application
' mb.Reset
' Next mb
Next

End Sub
Sub EnableCutAndPaste()
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
EnableControl 2521, True ' print
EnableControl 109, True ' print preview
EnableControl 4, True ' print...
EnableControl 3, True ' saveas
EnableControl 748, True ' saveas...
EnableControl 247, True ' pagesetup...
EnableControl 3823, True ' save as webpage
EnableControl 3655, True ' webpage preview
EnableControl 848, True ' move or copy sheet
EnableControl 30095, True ' send to
EnableControl 846, True ' save workspace
EnableControl 30255, True ' print area
EnableControl 762, True ' header & footer
EnableControl 846, True ' save workspace
EnableControl 30017, True 'macro
EnableControl 3738, True 'mail recipient


Application.OnKey "^s"
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "^w"
Application.OnKey "^p"
Application.OnKey "^+{F11}"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"

Application.CellDragAndDrop = True

Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(Id:=847)
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(Id:=889)
Ctrl.Enabled = True
Next Ctrl

For Each Ctrl In Application.CommandBars.FindControls(Id:=748)
Ctrl.Enabled = True
Next Ctrl

End Sub



when i remove the


If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
EndIf


the code will not work. So where does my mistake lies? How i can stop the macro from askign if i want to save or not to save?

[Ken Puls]

First off, let's look at why it asks you to save in the first place. The answer to that is that you are running a routine to hide certain sheets. This constitutes a change to the workbook, which will tip Excel's "saved" property to false.

I'm curious of the purpose to this file. Are you just trying to set up a template so that users can't save over the work, and also making sure that they enable macros?

What is the purpose of the workbook_open routine you have? If I read it correctly, it seems to re-open the same workbook, which then triggers the workbook_open routine in the next workbook and so on...

[bear]

The purpose of my code is to prevent people from copying my work and to aknowledge it as their work. Hence i got 2 same copy of file. one orginal where i can edit my work and one for people to view but they cant edit nor save my work.

As simple as that. But now when i use the code provided by you but i remove the following code,




If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
EndIf


It still prompt me a dialog box and ask if i want to save my work. i want the dialog box to be remove. So what should i do?

I know the problem lies in the hidesheet code, but i already remove the code mentioned above, why is there still a dialog box asking if i want to save my work?

[Ken Puls]

First off, we need to be clear on something. There is nothing, absolutely nothing, that you can do to prevent someone from cracking your workbook/code/work to get it if they want to badly enough. Every single password level in Excel can be removed, so your work is not secure. If you need ultimate security, you should probably be looking at creating a VSTO project or something.

If you're willing to accept that risk, then what I'd do is avoid the "BeforeClose" thing. Just don't let your users save it at all. You can override the BeforeSave routine to do this.

Have a look through our KB to see if there is an article there to cover it. If not, I'll mock something up for you tomorrow night if someone doesn't get to it first. (Have to go right now.)

[bear]

Erm..okay thanks for helping.
I am willing to take the risk.

I will go look at the KB to see if there is any posting i can use for the time being. If i manage to get my things done before i see your post, i will let you know. If not, i will have to reference your code again.

Thanks once again!

[bear]

Hey! I have done with the code. You no need to think of it anymore.
Thanks for the help.

What is KB post about?

I do want to share my code with others too!

[Ken Puls]

Hi Bear,

Glad to hear you got it sorted out. :)

The KB is a place where you can post your code samples. If you'd like to participate, I'd suggest you read a few of the other posts to see how they are written, then create a sample file. Once you log in to the KB, you'll see a CreateKBEntry button. Pretty much just follow the prompts from there and an approver will work with you on the entry once it is submitted.

Cheers,

[bear]

Hi all!

I got a problem here again.
Previously, Ken provide me with a useful macro to force user to enable macro.

But now, when i remove



If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
EndIf


the entire forcing user to enable macro thing doest work. why does this happen?