Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
I have the following code which displays a sheet called E-Splash if
you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
Private Sub Workbook_Open()
Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message ups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
On Jul 14, 3:24 pm, "Bob Phillips" wrote:
Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message ups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub- Hide quoted text - - Show quoted text - Thanks Bob, but where do you reference MyUsers2 ? Persumably in line - Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
On Jul 14, 4:34 pm, Sean wrote:
On Jul 14, 3:24 pm, "Bob Phillips" wrote: Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message oups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub- Hide quoted text - - Show quoted text - Thanks Bob, but where do you reference MyUsers2 ? Persumably in line - Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value- Hide quoted text - - Show quoted text - Bob getting stuck on line If Not IsError(.Application.Match(.UserName, myArray, 0)) Then At the .Username with message "invalid or unqualified reference". I entered .application before, don't get the error message but when I open the file I just get the E-Splash screen with no message. I would have expected to get E-Splash with the "Time Expired"message |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
On Jul 14, 4:50 pm, Sean wrote:
On Jul 14, 4:34 pm, Sean wrote: On Jul 14, 3:24 pm, "Bob Phillips" wrote: Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message oups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub- Hide quoted text - - Show quoted text - Thanks Bob, but where do you reference MyUsers2 ? Persumably in line - Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value- Hide quoted text - - Show quoted text - Bob getting stuck on line If Not IsError(.Application.Match(.UserName, myArray, 0)) Then At the .Username with message "invalid or unqualified reference". I entered .application before, don't get the error message but when I open the file I just get the E-Splash screen with no message. I would have expected to get E-Splash with the "Time Expired"message- Hide quoted text - - Show quoted text - Bob, your line If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Does this mean if the value in Now() is more than 35 days past A1 then "Time Expired" etc ? |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
Back to excel.
Select your range with the names Insert|Name|Define| and use the MyUsers as the name of that range. Sean wrote: On Jul 14, 3:24 pm, "Bob Phillips" wrote: Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message ups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub- Hide quoted text - - Show quoted text - Thanks Bob, but where do you reference MyUsers2 ? Persumably in line - Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value -- Dave Peterson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
Bob didn't have a dot in front of Application.
If you're having trouble, I'd copy the text of Bob's message and paste again. He very rarely makes typos in the code. (And just a few in the descriptive portion <vbg.) Sean wrote: On Jul 14, 4:34 pm, Sean wrote: On Jul 14, 3:24 pm, "Bob Phillips" wrote: Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message oups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub- Hide quoted text - - Show quoted text - Thanks Bob, but where do you reference MyUsers2 ? Persumably in line - Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value- Hide quoted text - - Show quoted text - Bob getting stuck on line If Not IsError(.Application.Match(.UserName, myArray, 0)) Then At the .Username with message "invalid or unqualified reference". I entered .application before, don't get the error message but when I open the file I just get the E-Splash screen with no message. I would have expected to get E-Splash with the "Time Expired"message -- Dave Peterson |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Add Code to File Opening Q
Date in VBA is like =today() in a worksheet cell.
It returns the current date--according to your computer's clock. Sean wrote: On Jul 14, 4:50 pm, Sean wrote: On Jul 14, 4:34 pm, Sean wrote: On Jul 14, 3:24 pm, "Bob Phillips" wrote: Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If IsError(Application.Match(Application.UserName, myArray, 0)) Then Call ErrorMsg("You are NOT Permitted to access this File ") Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value If Not IsError(Application.Match(.UserName, myArray, 0)) Then If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Call ErrorMsg("Time expired ") Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End If End If End Sub Private Sub ErrorMsg(ByVal msg As String) MsgBox msg & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False End Sub -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Sean" wrote in message oups.com... I have the following code which displays a sheet called E-Splash if you are not a user listed in named range MyUsers How can I add to this that a second condition would be applied that if you are listed also in MyUsers2 then unless A1 in sheet E-Users is within 35 days of Now() you can't access the file and a message as follows appears "Time Expired, Please contact etc etc" This would also mean that if you are in MyUsers and not in MyUsers2 you could access the file not matter how far Now() is from A1 Thanks Private Sub Workbook_Open() Dim myArray As Variant Dim arName As String Dim ws As Worksheet arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value With Application If IsError(.Application.Match(.UserName, myArray, 0)) Then MsgBox "You are NOT Permitted to access this File " & vbCr & _ "" & vbCr & _ "Please Contact Joe Bloggs at " & vbCr & _ "" & vbCr & _ "ABC Inc +0099 1 234567" Application.DisplayAlerts = False ThisWorkbook.Close False Else For Each ws In Worksheets ws.Visible = True Next Worksheets("E-Splash").Visible = False Worksheets("E-Users").Visible = xlVeryHidden Worksheets("E-Sum").Activate Application.DisplayAlerts = True End If End With End Sub- Hide quoted text - - Show quoted text - Thanks Bob, but where do you reference MyUsers2 ? Persumably in line - Else arName = "MyUsers" myArray = ThisWorkbook.Names(arName).RefersToRange.Value- Hide quoted text - - Show quoted text - Bob getting stuck on line If Not IsError(.Application.Match(.UserName, myArray, 0)) Then At the .Username with message "invalid or unqualified reference". I entered .application before, don't get the error message but when I open the file I just get the E-Splash screen with no message. I would have expected to get E-Splash with the "Time Expired"message- Hide quoted text - - Show quoted text - Bob, your line If Worksheets("E-Users").Range("A1").Value < Date Or _ Worksheets("E_Users").Range("A1").Value Date + 35 Then Does this mean if the value in Now() is more than 35 days past A1 then "Time Expired" etc ? -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
opening an existing text file useing code | Excel Programming | |||
macro code to change file-opening password | Excel Programming | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
VBA code halts after opening a file | Excel Programming | |||
Troubles opening a CSV file from code | Excel Programming |