I made a workbook in which some sheets are needed to be protected from watching since a lot of people are going to enter this sheet and I would like to have more sensative information in it which will not be available for all.
To do so I googled and found out the following code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = "Sheet1"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
which works perfectly for my needs but there is a problem.
The problem is as following, for it to work I need to force the user to enable macro commands and if you were to save the file then you'd have to save it as an macro-enabled workbook which is not something I trust my users to do.
My question is: Can I make so that without enabling the macro command you are unable to open the sheet without accepting the macros and you are unable to save as a normal Excel workbook?
I think the best answer here is password-protecting that worksheet using excel's built in functionality: http://www.excel-easy.com/examples/protect-sheet.html
EDIT: protecting sheet only prevents edits, suggested new method of hiding detailed here: http://www.techrepublic.com/blog/microsoft-office/hide-excel-sheets-really-hide-them/
Related
I have a file that I made with three levels of permissions.
You get prompted to input a password on a userform and you get either admin rights, read/write or only read permissions.
That works fine, unless you don't enable macros.
If you don't enable the macro prompting the userform is not shown and the rights are not set thus you have full access.
I have seen you can use a splash screen but for that to work you need to save the workbook as far as I understand?
The basic concept of them is to beforeclose hide sheets and unhide splash screen, then save the workbook.
But what if the user made a mistake and what to close without save and reopen later? The file gets closed with all sheets visible?
So I thought maybe I can use the "explorer -> right click -> properties -> Read-only" attribute as an extra layer of protection?
I found these functions.
ActiveWorkbook.ChangeFileAccess Mode:=xlreadonly
ActiveWorkbook.ChangeFileAccess Mode:=xlreadwrite
But I tried the readonly line and it did set read only, file could not be saved.
Then I closed the workbook without saving and opened again. But it seems the attribute was not set in the properties of the file since it was not tickmarked and when I opened the file I could save it.
Is there any other way to solve this?
I want to either "force" VBA on the user or make sure he/she can't save the file if it's opened without VBA.
I found a solution that seems to work.
You can in Workbook_BeforeClose use this line to make the file read-only in file properties.
SetAttr Application.ActiveWorkbook.FullName, vbReadonly
This will set the tickmark in the properties and Excel will notice the file is writeprotected.
Then in Workbook_Open() (or as in my case when rights has been established)
SetAttr Application.ActiveWorkbook.FullName, vbReadwrite
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
The first line removes the tickmark in file properties, but Excel still "remembers" the file as read-only.
The second line will tell Excel to make it ReadWrite and the file works as normal again.
This is a far more complicated method than Adreas', but doesn't feature the same risk of mildy tech-savvy users just right-clicking the file and popping into the "Properties" panel.
Create 2 new worksheets. One of them is set to xlVeryHidden - for the examples below, I have called it hsSheetStatus. The other, with a nice large notice telling your hapless minion colleague to enable Macros, will be changing visibility. I have called this hsEnableNotice.
Then I have a Macro to show hsEnableNotice hide all of the other sheets (storing their visibility and the ActiveSheet on hsSheetStatus), and a second Macro to do the reverse (restore visibility/ActiveSheet from hsSheetStatus) and set these to run on Workbook_BeforeSave, Workbook_AfterSave and Workbook_Open:
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
UnlockAndShow
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
LockAndHide
End Sub
Private Sub Workbook_Open()
UnlockAndShow
End Sub
Private Sub LockAndHide()
Dim lSheet As Long, ActiveName As String
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveName = ThisWorkbook.ActiveSheet.Name
hsEnableNotice.Visible = xlSheetVisible
hsEnableNotice.Activate
hsSheetStatus.Range(hsSheetStatus.Cells(1, 1), hsSheetStatus.Cells(hsSheetStatus.Rows.Count, 1)).EntireRow.Delete
For lSheet = 1 To ThisWorkbook.Sheets.Count 'By using Sheets instead of Worksheets, we include Charts etc
hsSheetStatus.Cells(lSheet, 1).Value = ThisWorkbook.Sheets(lSheet).Name
hsSheetStatus.Cells(lSheet, 2).Value = ThisWorkbook.Sheets(lSheet).Visible
If ThisWorkbook.Sheets(lSheet).Name = ActiveName Then hsSheetStatus.Cells(lSheet, 3).Value = 1
If ThisWorkbook.Sheets(lSheet).Name <> hsEnableNotice.Name Then ThisWorkbook.Sheets(lSheet).Visible = xlSheetVeryHidden
Next lSheet
ThisWorkbook.Protect Password:="ThisIsMyPassword.ThereAreManyLikeIt,ButThisOneIsMine.", Structure:=True, Windows:=False
Application.EnableEvents = True
End Sub
Private Sub UnlockAndShow()
Dim WasSaved As Boolean, lSheet As Long, lMax As Long
WasSaved = ThisWorkbook.Saved
Application.ScreenUpdating = False
Application.EnableEvents = False
lMax = hsSheetStatus.Cells(hsSheetStatus.Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Unprotect Password:="ThisIsMyPassword.ThereAreManyLikeIt,ButThisOneIsMine."
For lSheet = 1 To lMax
ThisWorkbook.Sheets(hsSheetStatus.Cells(lSheet, 1).Value).Visible = hsSheetStatus.Cells(lSheet, 2).Value
If hsSheetStatus.Cells(lSheet, 3).Value = 1 Then ThisWorkbook.Sheets(hsSheetStatus.Cells(lSheet, 1).Value).Activate
Next lSheet
hsSheetStatus.Visible = xlSheetVeryHidden
hsEnableNotice.Visible = xlSheetVeryHidden
Application.EnableEvents = True
Application.ScreenUpdating = True
ThisWorkbook.Saved = WasSaved
End Sub
I am new to Excel Add-ins and I am not sure how to write mi programm.
I would like to put in an add-in a code so that, when the workbook that uses the add-in is opened, it creates a sheet named "mainSheet".
I can use the event handler in the Workbook, but is it possible to put the code in the module of the add-in and still be able to run it?
I found this on the "Automate Excel" web site. Hope this helps
The following code works opening a workbook. It automatically adds a new sheet and labels it with the name. It also checks to see that the sheet doesn’t already exist – to allow for the possibility of it being opened more than once a day.
This code makes use of the Workbook Open Event and must be placed in the workbook module under the “Open work Book” event. The function Sheet_Exists must be placed in a module and this checks whether or not the sheet exists:
Private Sub Workbook_Open()
Dim New_Sheet_Name As String
New_Sheet_Name = "mainSheet"
If Sheet_Exists(New_Sheet_Name) = False Then
With Workbook
Worksheets.Add().Name = New_Sheet_Name
End With
End If
End Sub
==
Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
Sheet_Exists = False
For Each Work_sheet In ThisWorkbook.Worksheets
If Work_sheet.Name = WorkSheet_Name Then
Sheet_Exists = True
End If
Next
End Function
I have the following example code in a module of VBA:
Sub My_Code()
ThisWorkbook.Sheets("Main").Range("A1") = "Main Data"
ThisWorkbook.Sheets("Secondary").Range("A2").Copy Sheets("Main").Range("B2")
End Sub
and to protect the sheets, Main and Secondary, I have put the following code in Thisworkbook of VBA:
Private Sub Workbook_Open()
Sheets("Main").Protect Password:="Mypassword", UserInterfaceOnly:=True
Sheets("Secondary").Protect Password:="Mypassword", UserInterfaceOnly:=True
End Sub
When I run My_Code() I get the error:
""Run-time error '1004'
The cell or chart you're trying to change is on a protected sheet.
To make changes, click Unprotect Sheet in the Review tab (you might need a password).""
And this debugs to the ThisWorkbook.Sheets("Secondary").... line.
When I manually Unprotect the Main sheet the code runs. Any ideas why I can't leave Main protected? Have I forgotten something?
#jkpieterse Gave the solution to this question which was to change the second line of the My_Code() to
Thisworkbook.Sheets("Main").Range("B2").Value = ThisWorkbook.Sheets("Secondary").Range("A2").Value
However this created a new error in my code which is mentioned in the comments about. The who reason behind this problem is that the UserInterfaceOnly = true does not allow macros to modify the sheet, it only allows for value changes. Therefore there is no way to use the interface protect work around when you modify the worksheet. The only solution from here is:
Sub My_Code()
Dim ws as Worksheet
Set ws = ThisWorkbook.Sheets("Main")
ws.UnProtect Password:="Mypassword"
On Error GoTo ErrHandeler
ws.Range("A1") = "Main Data"
ThisWorkbook.Sheets("Secondary").Range("A2").Copy ws.Range("B2")
ws.Protect:="Mypassword"
ErrHandler:
ws.Protect:="Mypassword"
End Sub
This is the next most secure solution.
The cells that you want to populate data in or modify needs to be unlocked. So select the range of cells, then in format cell set them to be unlocked. When you password protect the sheet, make sure you check allow to edit unlocked cells.
Try this with you original code, it should work. Since it worked when you unprotected the sheet.
It appears you have to reset the protection with UserInterfaceOnly = True upon Workbook_Open, which resolves my issue. Excel closes the workbook with a default of UserInterfaceOnly = False (even though I run the secure commands on the Workbook_BeforeClose event.
Here is my issue, I have subs that work when I tested them with the sheet unlocked, but when I locked the sheet to protect certain cells from being selected or deleted/altered, the subs error out. So I need to add a part to my sub that unlocks, runs the main code, then re-locks the sheet.
I am looking for something like this
Sub Example ()
Dim sample as range
set sample as range("A3:Z100")
Application.ScreenUpdating = false
UN-PROTECT CODE
'Existing sub code here
RE-PROTECT CODE
Application.ScreenUpdating = True
End Sub
I am however unaware on what the code to achieve this should look like. I have tried researching and all I found was incomplete code that based on the comments, didn't work all the time. I did find a suggestion to upon error, have an error handler re-protect the sheet, but not sure how to write this either. Any suggestions?
Oh, and the people who will be using this sheet will not have access to the sheet password. I plan to have the module its self password protected and the subs attached to buttons. So placing the Sheet unlock password in the sub would be ok if it is needed.
Posting my original comment as an answer.
If you use the macro recorder and then protect & unprotect sheets, it will show you the code.
EDIT: Added the below.
If you attempt to unprotect a sheet that is not protected you will get an error. I use this function to test if a sheet is protected, store the result in a Boolean variable and then test the variable to see if a) the sheet must be unprotected before writing to it and b) to see if the sheet should be protected at the end of the proc.
Public Function SheetIsProtected(sheetToCheck As Worksheet) As Boolean
SheetIsProtected = sheetToCheck.ProtectContents
End Function
Do you need it to remove passwords? This worked for me
Sub macroProtect1()
Sheet1.Unprotect Password:="abc"
'Enable error-handling routine for any run-time error
On Error GoTo ErrHandler
'this code will run irrespective of an error or Error Handler
Sheet1.Cells(1, 1) = UCase("hello")
'this code will give a run-time error, because of division by zero. The worksheet will remain unprotected in the absence of an Error Handler.
Sheet1.Cells(2, 1) = 5 / 0
'this code will not run, because on encountering the above error, you go directly to the Error Handler
Sheet1.Cells(3, 1) = Application.Max(24, 112, 66, 4)
Sheet1.Protect Password:="abc"
ErrHandler:
Sheet1.Protect Password:="abc"
End Sub
had a similar problem and found this code on the web:
Sub protectAll()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Protect "password", true, true
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Sub Unprotect1()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Unprotect "password"
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Note that it is designed to protect / unprotect all sheets in the workbook, and works fine. Apologies, and respect, to the original author, I can't remember where I found it (But I don't claim it)...
The most common object that is Protected is the Worksheet Object This make it possible to preserve formulas by Locking the cells that contain them.
Sub Demo()
Dim sh As Worksheet
Set sh = ActiveSheet
sh.Unprotect
' DO YOUR THING
sh.Protect
End Sub
Here's my very simple technique for situations that don't require a password (which are most situations that I run into):
Dim IsProtected As Boolean
IsProtected = SomeWkSh.ProtectContents: If IsProtected Then SomeWkSh.Unprotect
'Do stuff on unprotected sheet...
If IsProtected Then SomeWkSh.Protect
You can, of course, simplify the syntax a bit by using a With SomeWkSh statement but if the "Do stuff..." part refers to properties for methods of a larger, spanning With statement object, then doing so will break that functionality.
Note also that the Protect method's Contents parameter defaults to True, so you don't have to explicitly specify that, although you can for clarity.
My question is as follows:
I have given a workbook to multiple people. They have this workbook in a folder of their choice. The workbook name is the same for all people, but folder locations vary.
Let's assume the common file name is MyData-1.xls.
Now I have updated the workbook and want to give it to these people. However when they receive the new one (let's call it MyData-2.xls) I want specific parts of their data pulled from their file (MyData-1) and automatically put into the new one provided (MyData-2).
The columns and cells to be copied/imported are identical for both workbooks. Let's assume I want to import cell data (values only) from MyData-1.xls, Sheet 1, cells B8 through C25 ... to ... the same location in the MyData-2.xls workbook. How can I specify in code (possibly attached to a macro driven import data now button) that I want this data brought into this new workbook. I have tried it at my own location by opening the two workbooks and using the copy/paste-special with links process. It works really well, but It seems to create a hard link between the two physical workbooks. I changed the name of the source workbook and it still worked. This makes me believe that there is a "hard link" between the tow and that this will not allow me to give the target (MyData-2.xls) workbook to others and have it find their source workbook.
To clarify my understanding, each user has a spreadsheet called MyData-1.xls but with varying locations. You would like to send each person a new spreadsheet MyData-2 which will automatically pull in data from range B8:C25 in MyData-1.xls?
There are various options on doing this and below I have provided one way of doing this. In short, the user will open MyData-2, click a button, and the code will search for MyData-1 on their directory, open the workbook, grab the data, paste it into MyData-2, and then close MyData-1.
Sub UpdateWorkbook()
'Identify workbook you would like to pull data from (same for all users)
Dim TargetWorkbook As String
TargetWorkbook = "MyData-1"
'Get the full path of that workbook by searching in a specified directory
Dim TargetPathName As String
TargetPathName = GetFilePath(TargetWorkbook)
'Retrieve data in range B8:C25, copy and paste, then close workbook
Dim TargetRng As Range
Application.ScreenUpdating = False
Workbooks.Open Filename:=TargetPathName
Set TargetRng = Sheets("Sheet1").Range("B8:C25")
TargetRng.Copy Destination:=ThisWorkbook.Worksheets(1).Range("B8:C25")
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Function GetFilePath(TargetWkbook As String) As String
Dim FullFilePath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
.Filename = TargetWkbook
If .Execute > 0 Then
FullFilePath = .FoundFiles(1)
End If
End With
GetFilePath = FullFilePath
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Function
By way of explanation:
In the sub you first need to specify the name of the workbook MyData-1
The Function GetFilePath will then get the full path name of the workbbok. Note that I have set it to look in the "C:\" drive and you may want to amend that
Once we have the full file path we can easily open the workbook and copy the required range.
Note that the screenupdating is turned off to create the 'illusion' that the workbook has not been opened when the data is copied. Also, I have added a button on the worksheet of MyData-2 to trigger the code i.e. user opens workbook, presses button, and data is imported.
Finally, this code could be augmented significantly and you may want to tweak it. For example, error checking if file not found, searching in multiple directories (e.g C:\, D:)...
Hope this gets you started on the right track
You should use the copy/paste-special for values only:
Private Sub ImportData_Click()
On Error GoTo OpenTheSheet
Workbooks("MyData-1.xls").Activate
GoTo SheetOpen
OpenTheSheet:
Workbooks.Open "MyData-1.xls"
Workbooks("MyData-1.xls").Activate
SheetOpen:
On Error GoTo 0
Workbooks("MyData-1.xls").Worksheets("sheetwhatever").firstRange.Copy
Workbooks("MyData-2.xls").Worksheets("anothersheet").yourRange.PasteSpecial(xlPasteValues)
End Sub
This could be cleaned up a bit, but it's always messy to do file stuff in VBA, I'd probably put the opening code in a function.
Make sure they put the new file in the same directory as the old file.