C
Chris Berry
Ok, I got this to work
Code:
--------------------
'Add the 3 lines below to the "ThisWorkbook" module - make sure to un-comment.
Public Sub Workbook_open()
Custom_Comment
End Sub
Const strMenuName As String = "New Comment"
Sub Custom_Comment()
Dim cb As CommandBar, MenuObject As CommandBarPopup
Dim NewSubMenu1 As CommandBarButton, NewSubMenu2 As CommandBarButton
Dim NewSubMenu3 As CommandBarButton, NewSubMenu4 As CommandBarButton
Const iBack1 = 9, iBack2 = 9, iBack3 = 9, iBack4 = 43
Const iText1 = 1, iText2 = 3, iText3 = 5, iText4 = 10
Remove_menu
'ensure no duplicates added
Set cb = Application.CommandBars("Cell")
Set MenuObject = cb.Controls.Add(Type:=msoControlPopup, temporary:=True)
With MenuObject
.Caption = strMenuName
.BeginGroup = True
With .Controls
Set NewSubMenu1 = .Add(Type:=msoControlButton, temporary:=True)
Set NewSubMenu2 = .Add(Type:=msoControlButton, temporary:=True)
Set NewSubMenu3 = .Add(Type:=msoControlButton, temporary:=True)
Set NewSubMenu4 = .Add(Type:=msoControlButton, temporary:=True)
End With
End With
NewSubMenu1.Caption = "White Background - Black Text - 10pt"
NewSubMenu1.OnAction = "'ApplyFormat " & iText1 & "," & iBack1 & "'"
NewSubMenu2.Caption = "White Background - Red Text - 10pt"
NewSubMenu2.OnAction = "'ApplyFormat " & iText2 & "," & iBack2 & "'"
NewSubMenu3.Caption = "White Background - Blue Text - 10pt"
NewSubMenu3.OnAction = "'ApplyFormat " & iText3 & "," & iBack3 & "'"
NewSubMenu4.Caption = "Yellow Background - Green Text - 12pt"
NewSubMenu4.OnAction = "'ApplyFormat " & iText4 & "," & iBack4 & "'"
End Sub
Sub Remove_menu()
On Error Resume Next 'in case it isn't there
Application.CommandBars("Cell").Controls(strMenuName).Delete
End Sub
Sub ApplyFormat(iText As Integer, iBack As Integer)
On Error Resume Next
ActiveCell.AddComment ""
On Error GoTo 0
With ActiveSheet.Shapes(ActiveCell.Comment.Shape.Name)
.Fill.ForeColor.SchemeColor = iBack
With .TextFrame
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlCenter
.AutoSize = True
.AutoMargins = False
.MarginLeft = 7.2
.MarginRight = 7.2
.MarginTop = 7.2
.MarginBottom = 7.2
With .Characters.Font
.Size = 10
.ColorIndex = iText
.Name = "Arial"
.Bold = False
.Italic = False
.Underline = False
End With
End With
.Visible = msoCTrue
.Select
End With
End Sub
--------------------
I got the code from Bill Jelen's website. How can I make it so that
this new command shows up on every excel file I open or new file I
create? The company I work for doesn't let us change any window
properties so I can't edit the format by changing the tool tips and
this is the only way to format comments I've been able to find.
Your help is greatly appreciated.
Chris
Code:
--------------------
'Add the 3 lines below to the "ThisWorkbook" module - make sure to un-comment.
Public Sub Workbook_open()
Custom_Comment
End Sub
Const strMenuName As String = "New Comment"
Sub Custom_Comment()
Dim cb As CommandBar, MenuObject As CommandBarPopup
Dim NewSubMenu1 As CommandBarButton, NewSubMenu2 As CommandBarButton
Dim NewSubMenu3 As CommandBarButton, NewSubMenu4 As CommandBarButton
Const iBack1 = 9, iBack2 = 9, iBack3 = 9, iBack4 = 43
Const iText1 = 1, iText2 = 3, iText3 = 5, iText4 = 10
Remove_menu
'ensure no duplicates added
Set cb = Application.CommandBars("Cell")
Set MenuObject = cb.Controls.Add(Type:=msoControlPopup, temporary:=True)
With MenuObject
.Caption = strMenuName
.BeginGroup = True
With .Controls
Set NewSubMenu1 = .Add(Type:=msoControlButton, temporary:=True)
Set NewSubMenu2 = .Add(Type:=msoControlButton, temporary:=True)
Set NewSubMenu3 = .Add(Type:=msoControlButton, temporary:=True)
Set NewSubMenu4 = .Add(Type:=msoControlButton, temporary:=True)
End With
End With
NewSubMenu1.Caption = "White Background - Black Text - 10pt"
NewSubMenu1.OnAction = "'ApplyFormat " & iText1 & "," & iBack1 & "'"
NewSubMenu2.Caption = "White Background - Red Text - 10pt"
NewSubMenu2.OnAction = "'ApplyFormat " & iText2 & "," & iBack2 & "'"
NewSubMenu3.Caption = "White Background - Blue Text - 10pt"
NewSubMenu3.OnAction = "'ApplyFormat " & iText3 & "," & iBack3 & "'"
NewSubMenu4.Caption = "Yellow Background - Green Text - 12pt"
NewSubMenu4.OnAction = "'ApplyFormat " & iText4 & "," & iBack4 & "'"
End Sub
Sub Remove_menu()
On Error Resume Next 'in case it isn't there
Application.CommandBars("Cell").Controls(strMenuName).Delete
End Sub
Sub ApplyFormat(iText As Integer, iBack As Integer)
On Error Resume Next
ActiveCell.AddComment ""
On Error GoTo 0
With ActiveSheet.Shapes(ActiveCell.Comment.Shape.Name)
.Fill.ForeColor.SchemeColor = iBack
With .TextFrame
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlCenter
.AutoSize = True
.AutoMargins = False
.MarginLeft = 7.2
.MarginRight = 7.2
.MarginTop = 7.2
.MarginBottom = 7.2
With .Characters.Font
.Size = 10
.ColorIndex = iText
.Name = "Arial"
.Bold = False
.Italic = False
.Underline = False
End With
End With
.Visible = msoCTrue
.Select
End With
End Sub
--------------------
I got the code from Bill Jelen's website. How can I make it so that
this new command shows up on every excel file I open or new file I
create? The company I work for doesn't let us change any window
properties so I can't edit the format by changing the tool tips and
this is the only way to format comments I've been able to find.
Your help is greatly appreciated.
Chris