Hi,
User entered data on Excel Sheet(s) and send to receipant. The returned
sheet(s) should be locked and should not be modfied by the receipant. It
works in Excel 2003. However, it does not work in Excel 2007. User sent the
worksheet(s) but the sheet(s) did not lock as in Excel 2003. Receipants can
modify the sheet(s). I tried many different ways without success.

Please help and thank you for your support.


Private Sub cmdEmail_Click()
Dim cnt As Integer
Dim destWb, srcWb As Workbook
Dim tmpWin, actWin As Window
Dim stWbPath As String
On Error Resume Next

If InStr(1, Sheets("Cluster A").Cells(3, 4), "Validated", vbTextCompare)
Then
Else
MsgBox "Form incomplete. Form did not sent."
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set srcWb = ActiveWorkbook
With srcWb
Set actWin = Active.Window
Set tmpWin = .NewWindow
cnt = Sheets("Cluster A").Cells(5, 2)
If cnt = 1 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets(Array("Cluster A")).Copy
ElseIf cnt = 2 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets("Cluster B").Range("I1:J49").ClearContents
.Sheets("Cluster B").Shapes("Drop down 12").Cut
.Sheets(Array("Cluster A", "Cluster B")).Copy
ElseIf cnt = 3 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets("Cluster B").Range("I1:J49").ClearContents
.Sheets("Cluster B").Shapes("Drop down 12").Cut
.Sheets("Cluster C").Range("I1:J49").ClearContents
.Sheets("Cluster C").Shapes("Drop down 13").Cut
.Sheets(Array("Cluster A", "Cluster B", "Cluster C")).Copy
End If
End With
tmpWin.Close
Set destWb = ActiveWorkbook
stWbPath = Environ$("temp") & "\"
If appVer < 12 Then
destWb.SaveAs stWbPath & "Company A Form " & Sheets("Cluster
A").Cells(3, 8) & ".xls"
Else
destWb.SaveAs stWbPath & "Company A Form " & Sheets("Cluster
A").Cells(3, 8) & ".xls", FileFormat:=56
End If

For ptr = 1 To cnt
destWb.Sheets(cnt).Select
ActiveSheet.Unprotect "$$$ Company1"
ActiveSheet.Cells.Select
Selection.Locked = True
Selection.FormulaHidden = True
ActiveSheet.Protect Password:="$$$ Company1", DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.Cells(3, 8).Select
Next ptr
destWb.SendMail ", "),
"Company A Form " & Sheets("Cluster A").Cells(3, 8) & " return."
destWb.Close False
MsgBox "Form has been sent to email receipants.", , "Send Form by Email"
Kill stWbPath & "Company A Form " & Sheets("Cluster A").Cells(3, 8) &
".xls"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.Close False
End Sub

Sorry guys, I found the problem, the code shoukd work after correcting one
error.

Set actWin = Active.Window shoud be Set actWin = ActiveWindow

"Perry" wrote:

Hi,
User entered data on Excel Sheet(s) and send to receipant. The returned
sheet(s) should be locked and should not be modfied by the receipant. It
works in Excel 2003. However, it does not work in Excel 2007. User sent the
worksheet(s) but the sheet(s) did not lock as in Excel 2003. Receipants can
modify the sheet(s). I tried many different ways without success.

Please help and thank you for your support.


Private Sub cmdEmail_Click()
Dim cnt As Integer
Dim destWb, srcWb As Workbook
Dim tmpWin, actWin As Window
Dim stWbPath As String
On Error Resume Next

If InStr(1, Sheets("Cluster A").Cells(3, 4), "Validated", vbTextCompare)
Then
Else
MsgBox "Form incomplete. Form did not sent."
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set srcWb = ActiveWorkbook
With srcWb
Set actWin = Active.Window
Set tmpWin = .NewWindow
cnt = Sheets("Cluster A").Cells(5, 2)
If cnt = 1 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets(Array("Cluster A")).Copy
ElseIf cnt = 2 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets("Cluster B").Range("I1:J49").ClearContents
.Sheets("Cluster B").Shapes("Drop down 12").Cut
.Sheets(Array("Cluster A", "Cluster B")).Copy
ElseIf cnt = 3 Then
.Sheets("Cluster A").Range("I1:J49").ClearContents
.Sheets("Cluster A").Shapes("Drop down 11").Cut
.Sheets("Cluster B").Range("I1:J49").ClearContents
.Sheets("Cluster B").Shapes("Drop down 12").Cut
.Sheets("Cluster C").Range("I1:J49").ClearContents
.Sheets("Cluster C").Shapes("Drop down 13").Cut
.Sheets(Array("Cluster A", "Cluster B", "Cluster C")).Copy
End If
End With
tmpWin.Close
Set destWb = ActiveWorkbook
stWbPath = Environ$("temp") & "\"
If appVer < 12 Then
destWb.SaveAs stWbPath & "Company A Form " & Sheets("Cluster
A").Cells(3, 8) & ".xls"
Else
destWb.SaveAs stWbPath & "Company A Form " & Sheets("Cluster
A").Cells(3, 8) & ".xls", FileFormat:=56
End If

For ptr = 1 To cnt
destWb.Sheets(cnt).Select
ActiveSheet.Unprotect "$$$ Company1"
ActiveSheet.Cells.Select
Selection.Locked = True
Selection.FormulaHidden = True
ActiveSheet.Protect Password:="$$$ Company1", DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.Cells(3, 8).Select
Next ptr
destWb.SendMail ", "),
"Company A Form " & Sheets("Cluster A").Cells(3, 8) & " return."
destWb.Close False
MsgBox "Form has been sent to email receipants.", , "Send Form by Email"
Kill stWbPath & "Company A Form " & Sheets("Cluster A").Cells(3, 8) &
".xls"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.Close False
End Sub

In message of Sun,
11 Apr 2010 19:40:01 in microsoft.public.excel.programming, Perry
writes
Sorry guys, I found the problem, the code shoukd work after correcting one
error.

Set actWin = Active.Window shoud be Set actWin = ActiveWindow

My suspicion was that option explicit would have identified your
problem. I tried the following in Excel 2003.
1) I copied and pasted your example.
2) Several lines had wrapped into invalid code. I unwrapped to fix.
3) The next line found your error:
Option Explicit ' Force explicit variable declaration.
4) It found 2 more which I "fixed" with the following at module level:
Const appVer = 12
Dim ptr As Integer

I find Option Explicit regularly protects me from idiocy.
I suggest the OP should use it in all his code.

However it does not protect me from hiding a variable with code like

Dim foo as Range

Sub bar()
Dim foo as Variant
....
foo.value = "fubar"
End Sub

Such code is a disaster waiting to happen if the second Dim statement is
deleted. I know of no automatic method of detecting such problems.

It is something I would like to see in a VBA Lint, if somebody would
write such code. cf. <http://en.wikipedia.org/wiki/Lint_%28software%29
--
Walter Briscoe