View Single Post
  #12   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson[_5_] Dave Peterson[_5_] is offline
external usenet poster
 
Posts: 1,758
Default protect a worksheet for everybody except the VBA writer

I added some message boxes at the end of your procedures.

When I tested your code, it worked fine--I saw the message boxes from both
procedures. So I can't even duplicate your problem.

I don't know what to suggest. Maybe someone else can see a problem????


Valeria wrote:

Hi Dave,
thank you! My error is so odd, I ran the code fixer and it worked once...
but just once! I was then having the same problem again.
I think I understood what disturbs Excel: if I run the first VBA-writer code
alone it works, the second alone works... what Excel does is that it goes
from the original workobook, where the code is, to the VBA of the target
workbook to write on it. At the end, it does not know anymore where it is, so
if I ask it to come back to my original code, it can't find it anymore,
that's why I get the message.
If I put the one VBA writer code at the end of my procedure, with no more
referring to other code, it works. And what I am doing now, after the macro
has finished working, I manually launch the second macro, which means I am
manually going back to the code of the original workbook.

It is quite complex to explain, I hope you understand what I mean!

A last question: do you know a way to force Excel to come back to the
original code it's executing?

Many thanks, I hope my experience was at least somehow useful!

Best regards,
Valeria

"Dave Peterson" wrote:

The only time I've seen a message like that is when I closed a the wrong
workbook in a macro and later refered to it like it was still open. But that
doesn't look like the case in your code.

Just silly guesses that might be a waste of your time.

Try running Rob Bovey's code cleaner against your workbook--it exports, deletes
modules and reimports your code. (you can also do it manually)

You can find it here.
http://www.appspro.com/

Sometimes hard to reproduce problems will be cleaned up.

Your code did work for me (after a couple of reformatting fixes -- because of
the line wrap in the newsgroup).

If you set up another test workbook with just enough data to make it useful and
copy over the macros, will it work?

(I don't have another guess.)

You could search google. Maybe there'll be someone who had similar problems and
got a solution that will work for you, too.



Valeria wrote:

Hi Dave,
It works now! :-)
I only have a major problem when I make this code written from another
macro: I have posted my problem but nobody has answered yet! :-(
I get the error "the object invoked has disconnected from its clients"!
The code is the following - quite long, I know, one part is this code, the
other part is 3 charts hyperlinks!)
Do you know what's going on?
Many thans in advance for your kindness!
Best regards,
Valeria

Sub Write_VBA_For_Security_ID()

Dim StartLine As Long
Workbooks(Montly_Report).Worksheets("Approvals_PM_ Violations").Activate
Range("a1").Select
With ActiveWorkbook.VBProject.VBComponents("Sheet4").Co deModule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, _
"dim vrange as range" & Chr(13) & _
"dim vvrange as range" & Chr(13) & _
"Dim cell As Object" & Chr(13) & _
"Set vrange = Range(""ID_Conf"")" & Chr(13) & _
"Set vvrange = Range(""Approval_Granted_For"")" & Chr(13) & _
"Me.Unprotect Password:=""my_password""" & Chr(13) & _
"Application.EnableEvents = False" & Chr(13) & _
"On Error Resume Next" & Chr(13) & _
"For Each cell In Target" & Chr(13) & _
"If Union(cell, vrange).Address = vrange.Address Then" & Chr(13) & _
"Target.Offset(0, 1).Value = Application.UserName" & Chr(13) & _
"Target.Offset(0, 2).Value = Format(Date, ""DD-MMM-YYYY"")" & Chr(13) & _
"ElseIf Union(cell, vvrange).Address = vvrange.Address Then" & Chr(13) & _
"Target.Offset(0, 1).Value = Month(Now -33 + 30 * Target.Cells.Value) &
""/"" & ""01/"" & Year(Now -33 + 30 * Target.Cells.Value)" & Chr(13) & _
"End If" & Chr(13) & _
"Next cell" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"Application.enableevents = true" & Chr(13) & _
"Me.Protect Password:=""my_password"""
End With

End Sub

Sub Write_VBA_For_Charts()

Dim StartLine As Long
Workbooks(Montly_Report).Activate

With ActiveWorkbook.VBProject.VBComponents("Sheet10").C odeModule
StartLine = .CreateEventProc("BeforeRightClick", "Worksheet") + 1
.InsertLines StartLine, _
"Application.EnableEvents = False" & Chr(13) & _
"If Not Intersect(Target, Range(""d12:f12"")) Is Nothing Then" &
Chr(13) & _
" Cancel = True" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d15:f15"")) Is Nothing Then" &
Chr(13) & _
" Cancel = True" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d20:e20"")) Is Nothing Then" &
Chr(13) & _
" Cancel = True" & Chr(13) & _
"Application.enableevents = true" & Chr(13) & _
"End If" & Chr(13)

End With

With ActiveWorkbook.VBProject.VBComponents("Sheet10").C odeModule
StartLine = .CreateEventProc("SelectionChange", "Worksheet") + 1
.InsertLines StartLine, _
"Application.enableevents = false" & Chr(13) & _
"If Not Intersect(Target, Range(""d12:f12"")) Is Nothing Then" &
Chr(13) & _
" On Error Resume Next" & Chr(13) & _
" Charts(""Chart1_Average PM Violation"").Activate" & Chr(13) & _
" If Err.Number < 0 Then" & Chr(13) & _
" MsgBox ""No such chart exists."", vbCritical, ""Chart Not Found""
" & Chr(13) & _
"End If" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d15:f15"")) Is Nothing Then" &
Chr(13) & _
" On Error Resume Next" & Chr(13) & _
" Charts(""Chart2_Volume Split by PM Range"").Activate" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"End If" & Chr(13) & _
"If Not Intersect(Target, Range(""d20:e20"")) Is Nothing Then" &
Chr(13) & _
" On Error Resume Next" & Chr(13) & _
" Charts(""Chart3_Top 10 Violators"").Activate" & Chr(13) & _
" If Err.Number < 0 Then" & Chr(13) & _
" MsgBox ""No such chart exists."", vbCritical, ""Chart Not Found""
" & Chr(13) & _
"End If" & Chr(13) & _
"On Error GoTo 0" & Chr(13) & _
"Application.enableevents = true" & Chr(13) & _
"End If"
End With

Worksheets("Instructions").Activate
End Sub

"Dave Peterson" wrote:

One major reason. I left out an important line!

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim cell As Object
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
Me.Unprotect Password:="my_password"

Application.EnableEvents = False
On Error Resume Next
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
Target.Offset(0, 1).Value = Application.UserName
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 _
* Target.Cells.Value) & "/" _
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error goto 0
Application.enableevents = true '<-------this is the line!
Me.Protect Password:="my_password"
End Sub

Sorry.

(if you turn off the .enableevents to stop your code from calling itself, you've
got to remember to turn it back on when you're done. (Replace "You" with "I" in
that last sentence!)

Valeria wrote:

Hi Dave,
I am not quite sure why it does this, but when I input your code with the
application.enableevents=false it works once, for the first cell I change,
and then it does not work anymore. I can input whatever cell in my target
range, without triggering the worksheet_Change macro...
And afterwards, I need to close down Excel to make it work again, even with
the other code that works with the 2 unprotect passwords.
Is there any reason for this?

Many thanks!
Best regards,
Valeria

<<snipped
--

Dave Peterson


--

Dave Peterson


--

Dave Peterson