I am using this code to password protect two pages.
For some weird reason I can hide "Sheet1" but not "Sheet2" as its always visiable.
The reason for the line Sheets(MySheet2).Visible = True is so if someone puts in the wrong password it won't just hide it instantly.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = "Sheet1"
MySheet2 ="Sheet2"
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
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = MySheet2 Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet2).Visible = True
Application.EnableEvents = False
Sheets(MySheet2).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet2).Visible = True
End Sub
I guess you're after this:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
With ActiveSheet
Select Case .Name
Case "Sheet1", "Sheet2"
Application.EnableEvents = False
.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
.Visible = True
.Select
End If
Application.EnableEvents = True
End Select
End With
End Sub
as you should already know, this code is to be placed in ThisWorkbook code pane
Related
I have a drop down list that has values "yes"/"no" (cell F 20) and button in the next cell ( cell G 20).
If user, selects "yes", button will be visible which he could click to add "Sheets"
If he selects "no", button will be hidden.
My question : I have write a code that will throw a warning if user has selected "yes" and not added new sheet and it should revert the value from drop down to "no" in this case.
I am not sure, what to include in my code that will serve my purpose?
Code on worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim str1 As String
ThisWorkbook.Unprotect Password:="xyz"
If Target.Address = "$F$20" Then
Select Case UCase(Target)
Case Is = "YES": Shapes("Button 8").Visible = msoTrue
Case Is = "NO": Shapes("Button 8").Visible = msoFalse
Code on Module (Button)
Sub insertSheet()
Application.ScreenUpdating = False
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim ws As Worksheet
worksh = Application.Sheets.Count
worksheetexists = False
ThisWorkbook.Unprotect Password:="xyz"
For x = 1 To worksh
If Worksheets(x).Name = "Sheet" Then
worksheetexists = True
MsgBox "Sheet Already Exists"
'Debug.Print worksheetexists
Exit For
End If
Next x
If worksheetexists = False Then
Sheets("BrownSheet").Visible = True
ActiveWorkbook.Sheets("BrownSheet").Copy _
After:=ActiveWorkbook.Sheets("BrownSheet")
Sheets("BrownSheet").Visible = False
ActiveSheet.Name = "Sheet"
ActiveSheet.Protect Password:="xyz", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ThisWorkbook.Protect Password:="xyz"
End Sub
Please help!!
Thanks
Place this code in the ThisWorkbook module and make the necessary changes to the sheet names.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Worksheets("mySheet").Range("F20").Value = "Yes" Then
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Sheet" Then
Dim bOk As Boolean
bOk = True
Exit For
End If
Next
End If
If Not bOk Then
MsgBox "Please add the sheet before saving!"
Cancel = True
End If
End Sub
For more on Before Save see MSDN Article
I want to know my error in my VBA code in my Excel and want some cells to be blocked if a another cell value is true.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Cells(35, "CD").Value = True Then
ActiveSheet.Range("R29:AA38").Locked = True
Else
ActiveSheet.Range("R29:AA38").Locked = False
End If
End Sub
can you help me with that please!
Try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Set Ws = Target.Worksheet
Ws.Unprotect "pw" ' change to your password
If CBool(Ws.Cells(35, "CD")) = True Then
If MsgBox("Do you want to Lock the cells", vbYesNo) = vbYes Then
Ws.Range("R29:AA38").Locked = True
else
Ws.Range("R29:AA38").Locked = False ' delete this line if you don't need it
Application.EnableEvents = False
Ws.Range("R29:AA38").ClearContents
Application.EnableEvents = True
end if
else
Ws.Range("R29:AA38").Locked = False
end if
Ws.Protect "pw" ' change to your password
End Sub
I have an Exit button on a userform. If the user clicks it I want it to return Excel's settings to it's original values and then close the workbook. The code in the Exit button is as follows:
Unload Me
If g_Released Then
ThisWorkbook.Close savechanges:=False
End If
The code in the Workbook_BeforeClose event is:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bSaved As Boolean
bSaved = ThisWorkbook.Saved
ActiveWindow.DisplayWorkbookTabs = True
'more code here
The last line does not cause the workbook tabs to be displayed. Further in the code I also try to set things like Application.DisplayFormulaBar = True and so forth, but none of them have any impact. It appears as if these properties has somehow been forced into a read-only state, but I don't know why.
Edit: Here is the complete code.
Private Sub Workbook_Open()
InitialiseVariables
Application.ScreenUpdating = False
HideExcelUI Application, False, True, False, "Some Company", "Budgeting Module Release 0.1", ThisWorkbook.Path & "\Logo.ico"
HideWorksheetsUI False, False, False
wsBackground.Select
With Application
.WindowState = xlNormal
.Height = frmMain.Height
.Width = frmMain.Width
End With
Application.ScreenUpdating = True
DisplayFormInCenter frmMain
End Sub
Public Sub InitialiseVariables()
g_tDBfolder = ThisWorkbook.Path & "\"
Set g_cn = New ADODB.Connection
With g_cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source") = g_tDBfolder & g_tDBname
.Open
End With
g_ScenarioIsSaved = True
g_ScenarioID = CLng([Scenario_ID])
Set g_rBudgetYear = [BudgetYear]
Set g_rStartMonth = [StartMonth]
Set g_rDealerName = [DealerName]
Set g_rScenario = [Scenario]
End Sub
Public Sub HideExcelUI(ByRef xlApp As Excel.Application, _
ByVal ShowFormulaBar As Boolean, ByVal ShowScrollBars As Boolean, ByVal ShowStatusBar As Boolean, _
Optional ByVal strApplicationCaption As String, Optional ByVal strWindowCaption As String, Optional ByVal strIcoFile As String)
With xlApp
.ExecuteExcel4Macro "SHOW.TOOLBAR(""RIBBON"",FALSE)"
.DisplayFormulaBar = ShowFormulaBar
.DisplayScrollBars = ShowScrollBars
.DisplayStatusBar = ShowStatusBar
If strApplicationCaption <> "" Then
.Caption = strApplicationCaption
End If
If strWindowCaption <> "" Then
.Windows(1).Caption = strWindowCaption
End If
If strIcoFile <> "" Then
SetIcon strIcoFile, 0
End If
End With
End Sub
Public Sub HideWorksheetsUI(ByVal ShowGridlines As Boolean, ByVal ShowHeadings As Boolean, ByVal ShowWorkbookTabs As Boolean)
Dim ws As Worksheet, wsCurrent As Worksheet
Application.ScreenUpdating = False
Set wsCurrent = ActiveSheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayWorkbookTabs = False
.Caption = ""
End With
Next
wsCurrent.Activate
Application.ScreenUpdating = True
End Sub
Public Sub DisplayFormInCenter(ByVal objForm As Object, Optional ByVal bModeless As Boolean)
With objForm
.startupposition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
If bModeless Then
.Show vbModeless
Else
.Show
End If
End With
End Sub
Private Sub ExitButton_Click()
Unload Me
If g_Released Then
ThisWorkbook.Close savechanges:=False
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bSaved As Boolean, Success As Boolean
Dim UserResponse As Long
bSaved = ThisWorkbook.Saved
ActiveWindow.DisplayWorkbookTabs = True
If g_Released Then
If Not g_ScenarioIsSaved Then
UserResponse = MsgBox(Prompt:="There are unsaved changes in the current budget. Save changes?", Buttons:=vbYesNoCancel)
If UserResponse = vbYes Then
Success = SaveInputs(ActiveSheet)
If Not Success Then
MsgBox "Unexpected error. All inputs were not saved. Please contact vendor."
End If
ElseIf UserResponse = vbNo Then
'Go ahead and close
Else
Cancel = True
End If
End If
End If
ResetIconToExcel
ThisWorkbook.Saved = bSaved
End Sub
I have code in this module:
Sub HideSalTable()
User = Worksheets("log").Range("R1").Value
If User = ThisWorkbook.Worksheets("SSSSSS").Range("za1").Value Then
Columns("S:AA").EntireColumn.Hidden = True
ElseIf User = ThisWorkbook.Worksheets("SSSSSS").Range("za3").Value Then
Columns("S:AA").EntireColumn.Hidden = False
ElseIf User = ThisWorkbook.Worksheets("SSSSSS").Range("za4").Value Then
Columns("S:AA").EntireColumn.Hidden = False
End If
End Sub
I have a button to redirect me to ThisWorkbook.Worksheets("SSSSSS") with this code:
Private Sub Change_SSSSSS_Button_Click()
Dim pass1 As String
Dim pass2 As String
pass1 = ThisWorkbook.Worksheets("SSSSSS").Range("za3").Value
pass2 = ThisWorkbook.Worksheets("SSSSSS").Range("za4").Value
Dim Inp
Dim lTries As Long
lTries = 1
Do
Inp = InputBoxDK("enter password", "Zmhnk")
If Inp = "" Or Inp = vbCancel Then Exit Sub '* Cancel button pressed or nothing entered
If Inp = (pass1) Or Inp = (pass2) Then
Exit Do
End If
lTries = lTries + 1
If lTries > 4 Then
MsgBox "Error", vbInformation, "Zmhnk"
Exit Sub
Else
If MsgBox("try again", vbYesNo, "error_Zmhnk") = vbNo Then Exit Sub
End If
Loop
Application.ScreenUpdating = False
Sheets("SSSSSS").Visible = True
Sheets("SSSSSS").Activate
Application.ScreenUpdating = True
End Sub
The problem is when the user presses the button with the 2nd code I face an error and I don't know why.
The error:
Unable to set the hidden property of the range class run time error '1003'
Two things
1) You have not fully qualified your range. I understand that you are getting redirected but this is much safer.
Columns("S:AA").EntireColumn.Hidden = True
Change it to
ThisWorkbook.Sheets("SSSSSS").Columns("S:AA").EntireColumn.Hidden = True
2) I believe your worksheet is protected. You have to unprotect it. You can do that as follows
ThisWorkbook.Sheets("SSSSSS").Unprotect "myPassword"
when you have the control from the Form there is no Problem
but if you have it from the worksheet itself then it works actually but with Error:1004
so just use ( On Error Resume Next)
Private Sub ComboBox1_Change()
Dim wsMon As Worksheet
Set wsMon = ThisWorkbook.Worksheets("Montag")
On Error Resume Next
Select Case ComboBox1.ListIndex
Case 0
xHide (False)
wsMon.Rows("12:25").EntireRow.Hidden = True
xHide (True)
Case 1
xHide (False)
wsMon.Rows("12:25").EntireRow.Hidden = False
wsMon.Rows("19:25").EntireRow.Hidden = True
xHide (True)
Case 2
xHide (False)
wsMon.Rows("12:25").EntireRow.Hidden = False
xHide (True)
End Select
End Sub
xHide is a Boolean Function :
true
Application.ScreenUpdating = True
Application.DisplayAlerts = True
or False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
I had a similar issue (only the error code was 1004, but the error message was the same). What solved the issue at my Excel sheet was to remove a comment which was within the range that I tried to hide. It seems like comments are not allowed within the range that should be hidden.
I have a spreadsheet that is edited by multiple users. To prevent tampering with previous data the cells are locked once data has been entered and the file saved. I have a few small bugs in the code though:
Even if the user has saved manually and then exits the application they are still prompted to save again.
The cells should be locked after a save when the application is running and not just when it is exited. Previously I had this code in the before_save event but the cells were being locked even if a save_as event was cancelled so I removed the code for now. Fixed
(Edit: I've just realised how obvious this error was. I even said it in this statement! Trying to lock cells after a save event using a before save event sub! )
Code
With ActiveSheet
.Unprotect Password:="oVc0obr02WpXeZGy"
.Cells.Locked = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:="oVc0obr02WpXeZGy"
End With
The workbook open, hide all sheets and show all sheets subs are used to force the end user into enabling macros. Here is the full code:
Option Explicit
Const WelcomePage = "Macros"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim wsActive As Worksheet
Dim vFilename As Variant
Dim bSaved As Boolean
'Turn off screen updating
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Record active worksheet
Set wsActive = ActiveSheet
'Prompt for Save As
If SaveAsUI = True Then
vFilename = Application.GetSaveAsFilename("", fileFilter:="Excel Files (*.xls), *.xls")
If CStr(vFilename) = "False" Then
bSaved = False
Else
'Save the workbook using the supplied filename
Call HideAllSheets
ThisWorkbook.SaveAs vFilename
Application.RecentFiles.Add vFilename
Call ShowAllSheets
bSaved = True
End If
Else
'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
End If
'Restore file to where user was
wsActive.Activate
'Restore screen updates
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Set application states appropriately
If bSaved Then
ThisWorkbook.Saved = True
Cancel = True
Else
Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
Private Sub HideAllSheets()
Dim ws As Worksheet
Worksheets(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
'Lock Cells upon exit save if data has been entered
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Cell As Range
With ActiveSheet
.Unprotect Password:="oVc0obr02WpXeZGy"
.Cells.Locked = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:="oVc0obr02WpXeZGy"
End With
End Sub
Thanks :)
It is asking for them to save before exiting even though they have already saved because of these lines:
'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
You are changing the worksheet after saving it (by calling ShowAllSheets) so it does need to be saved again. The same is true of the saveAs code.
I fixed the second problem by using another IF. This ensures the cells are only locked if the data is saved:
'Lock Cells before save if data has been entered
Dim rpcell As Range
With ActiveSheet
If bSaved = True Then
.Unprotect Password:="oVc0obr02WpXeZGy"
.Cells.Locked = False
For Each rpcell In ActiveSheet.UsedRange
If rpcell.Value = "" Then
rpcell.Locked = False
Else
rpcell.Locked = True
End If
Next rpcell
.Protect Password:="oVc0obr02WpXeZGy"
Else
MsgBox "The LogBook was not saved. You are free to edit the RP Log again", vbOKOnly, "LogBook Not Saved"
End If
End With