Adding a Comment on a protected sheet

[Sean]

Hi all,

I have a workbook that is used for estimating, Which i have protected
by a password. I'm trying to allow the user to be able to insert
comments and am unable to do so when it is protected. I am currently
using this macro:

Private Sub Workbook_Open()
With Worksheets("Building 1")
..Protect Password:="12345", userinterfaceonly:=True
..EnableOutlining = True
End With

To allow the user to use the outline function; the +/- feature. I know
you should be able to go to tool->protection--> and check edit objects
to allow the user to insert comments, it works while i have the
workbook open, but as soon as i close it an open the file again, i can
no longer insert comments. Does anyone have a macro that will allow a
user to inser a comment cells that are only unlocked?

Thank you,

Sean

 

[Dave Peterson]

You have responses to your post in .misc.

Hi all,

I have a workbook that is used for estimating, Which i have protected
by a password. I'm trying to allow the user to be able to insert
comments and am unable to do so when it is protected. I am currently
using this macro:

Private Sub Workbook_Open()
With Worksheets("Building 1")
.Protect Password:="12345", userinterfaceonly:=True
.EnableOutlining = True
End With

To allow the user to use the outline function; the +/- feature. I know
you should be able to go to tool->protection--> and check edit objects
to allow the user to insert comments, it works while i have the
workbook open, but as soon as i close it an open the file again, i can
no longer insert comments. Does anyone have a macro that will allow a
user to inser a comment cells that are only unlocked?

Thank you,

Sean

 

[Joergen Bondesen]

Hi Sean.

Try belowe, please.

'// MODULE

Option Explicit
Declare Function Get_User_Name Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long

Public Const PW As String = "Building 1"
Public Const hil As String = "Best Regards from Joergen Bondesen"

'----------------------------------------------------------
' Procedure : CommentInsertInLockedSheet
' Date : 20060717
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Add a Comment in Protected sheet.
' Note : Each Comments is a new line.
' Line starts with yyyymmdd hh:mm | User |
'----------------------------------------------------------
'
Sub CommentInsertInLockedSheet()

Dim ComSheet As Worksheet
Dim Username As String
Dim newcomments As String
Dim UserDate As String

Set ComSheet = Sheets("Com")

'// Only one cell
If Selection.Cells.Count <> 1 Then
MsgBox "Select only One cell, please. " _
& "Macro will terminate, sorry", vbCritical, hil
End
End If

'// Seletc sheet
ComSheet.Select

'// Unprotect
ComSheet.Unprotect (PW)

'// Unlock Cell
ActiveCell.Locked = False

Username = GetUserName

UserDate = Format(Now, "yyyymmdd hh:mm") & " | " _
& Username & " | "

'// Add comments
With ActiveCell
If .Comment Is Nothing Then
newcomments = _
InputBox("Enter text for Comment, please", hil)

.AddComment UserDate & newcomments

.Comment.Shape.TextFrame.AutoSize = True
Else
Dim CommentText As String
CommentText = .Comment.Text
.ClearComments

newcomments = _
InputBox("Enter text for Comment, please" _
& vbCrLf & vbCrLf & CommentText, hil)

.AddComment CommentText & Chr(10) _
& UserDate & newcomments
.Comment.Shape.TextFrame.AutoSize = True
End If
End With

'// protect
ComSheet.Protect (PW)

Set ComSheet = Nothing
End Sub


Function GetUserName() As String
Dim lpBuff As String * 25

Get_User_Name lpBuff, 25
GetUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function

 

[Joergen Bondesen]

Hi Sean

The Macro I send yesterday is very bad, sorry.
For compensation use below, please.


'// MODULE
Option Explicit
Declare Function Get_User_Name Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long

Const PassWord As String = "jb"
Const Sheetname As String = "Com"
Const hil As String = "Best Regards from Joergen Bondesen"

'----------------------------------------------------------
' Procedure : CommentInsertInLockedSheet
' Date : 20060718
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Add a Comment in Protected sheet.
' Note : Each Comments is a new line.
' Line starts with yyyymmdd hh:mm | User | x
' Unlocked cell will stay Unlocked.
' UnProtected sheet will stay UnProtected.
'----------------------------------------------------------
'
Sub CommentInsertInLockedSheet()

Dim ComSheet As Worksheet
Dim LockedBool As Boolean
Dim ProtectedSheedBool As Boolean
Dim Username As String
Dim newcomments As String
Dim UserDate As String
Dim CommentText As String


Set ComSheet = Sheets(Sheetname)

'// Only One Cell
If Selection.Cells.Count <> 1 Then
MsgBox "Select only One cell, please. " _
& "Macro will terminate, sorry", vbCritical, hil
End
End If

'// Seletc sheet
ComSheet.Select

If ComSheet.ProtectContents = True Then
'// Unprotect
ComSheet.Unprotect (PassWord)
ProtectedSheedBool = True
End If

'// Locked cell ?
If ActiveCell.Locked = True Then
'// Unlock Cell
ActiveCell.Locked = False
LockedBool = True
End If

'// Username
Username = GetUserName

'// Date and Username
UserDate = Format(Now, "yyyymmdd hh:mm") & " | " _
& Username & " | "

'// Add comments
With ActiveCell
If .Comment Is Nothing Then
'// Inputbox
newcomments = _
InputBox("Enter text for Comment, please", hil)

If newcomments = vbNullString Then GoTo XIT

'// Add Comments
.AddComment UserDate & newcomments

'// AutoSize Comments
.Comment.Shape.TextFrame.AutoSize = True
Else
'// Existing Comments
CommentText = .Comment.Text

'// New Comments
newcomments = _
InputBox("Enter text for Comment, please" _
& vbCrLf & vbCrLf & CommentText, hil)

If newcomments = vbNullString Then GoTo XIT

'// Clear Comments
.ClearComments

'// Add Existing and New Comments
.AddComment CommentText & Chr(10) _
& UserDate & newcomments

'// AutoSize Comments
.Comment.Shape.TextFrame.AutoSize = True
End If
End With

XIT:

If LockedBool = True Then
'// Lock Cell
ActiveCell.Locked = True
End If

If ProtectedSheedBool = True Then
'// protect Sheet
ComSheet.Protect (PassWord)
End If

'// Reset
Set ComSheet = Nothing
End Sub


'----------------------------------------------------------
' Procedure : GetUserName
' Date : 20060718
' Author : Unknown
' Modifyed by : Joergen Bondesen
' Purpose : Get Username
' Note :
'----------------------------------------------------------
'
Function GetUserName() As String
Dim lpBuff As String * 25

Get_User_Name lpBuff, 25
GetUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function