Disable Button When Worksheet is Locked

[Gerard Sanchez]

I have a macro that emails the first page of a worksheet from

http://www.rondebruin.nl/mail/folder3/mail4.htm

However, this macro doesn't work if the worksheet is locked.

I was wondering if there is a way for me to make some sort of a button
visual cue (i.e. grayed out) or an error message box to let the user know he
needs to unlocked the worksheet first.

Or on another note, maybe a pie in the sky request, to include within the
macro a code to unlocked worsheet first then lock it back again when email
has been sent.

Thanks

 

[Per Jessen]

Hi

When you say the workshet is locked I assume it is protected.

Worksheets("Sheet1").unprotect Password:="JustMe"
'Your code to mail sheet
Worksheets("Sheet1").Protect Password:= "JustMe"

Regards,
Per

 

[Gerard Sanchez]

'Hi Per,

'I tried placing the codes inside and outside the macro and I can't seem to
make it work.
Here's the macro I am using from RondeBruin:

Option Explicit

Sub Mail_Selection_Range_Outlook_Body()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next

Set rng = Range("A3:I16").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "(e-mail address removed)"
.CC = ""
.BCC = ""
.Subject = "Lockbox Day Summary Report"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)

Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") &
".htm"

rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function

 

[Gerard Sanchez]

'I just realized the problem is that I have a subroutine in my workseet that
'automatically names the sheet as edit date:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim dateTemp As Date

ActiveSheet.Names.Add Name:="_timestamp", RefersTo:=Now()
dateTemp = Val(Mid(ActiveSheet.Names("_timestamp"), 2))

ActiveSheet.Name = Format(dateTemp, "mmm dd")

End Sub

'Shucks how do I make this work??

 

[Gerard Sanchez]

FOUND the Solution

activesheet.protect "password"
activesheet.unprotect "password"

Thanks Ron!