Replicating the Format Painter - to add to right-click menu

[Guest]

I was trying to replicate the format painter icon (on the toolbar) and place
same
option on the short-cut menu. performed the below via a recorded macro, but
nee to be able the

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/13/2007 by Jim May

Selection.Copy
ActiveCell.Offset(4, 2).Range("A1").Select ' << Needs to be a Clicked
cell in the spreadsheet - but how can I speak to that here???????
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Select
End Sub

 

[JW]

I was trying to replicate the format painter icon (on the toolbar) and place
same
option on the short-cut menu. performed the below via a recorded macro, but
nee to be able the

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/13/2007 by Jim May

Selection.Copy
ActiveCell.Offset(4, 2).Range("A1").Select ' << Needs to be a Clicked
cell in the spreadsheet - but how can I speak to that here???????
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Select
End Sub

So, you just want to add something like a Paste Formats button to the
right click menu, correct? If so,....

Place this in the ThisWorkbook module of the applicable workbook.
Private Sub Workbook_Deactivate()
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Paste Formats").Delete
End With
On Error GoTo 0
End Sub

Private Sub Workbook_SheetBeforeRightClick _
(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Workbook_Deactivate
With Application.CommandBars("Cell"). _
Controls.Add(Type:=msoControlButton, Temporary:=True)
.Caption = "Paste Formats"
.BeginGroup = True
'change to the location of your macro
.OnAction = "Module2.pasteFormats"
If Not Application.CommandBars _
.FindControl(ID:=22).Enabled Then _
.Enabled = False
End With
End Sub


In a standard module, place something like this:
Sub pasteFormats()
On Error Resume Next
Selection.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End Sub

 

[Chip Pearson]

Jim,

The following code will add the Format Painter to the right-click menu:

Application.CommandBars("Cell").Controls.Add ID:=108, temporary:=True


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Guest]

I only want this in a sample file - not all future or current workbooks.
Would I not add the code you provided to my Workbook.open
and then don't I need a On Workbook.Close
code to Remove it?

Thanks,

Jim May

 

[Gord Dibben]

Not sure what you are looking for Jim.

Your code copies the format from whichever cell is active when you run the macro
and pastes to the cell at offset(4, 2)

Is the Range("A1") what concerns you?

Excel always does this when you are recording in Relative Reference mode but
code still copies and pastes relative to the activecell.

You can remove it should you choose.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/13/2007 by Jim May
Selection.Copy
ActiveCell.Offset(4, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Select
End Sub


Gord Dibben MS Excel MVP

 

[Chip Pearson]

The control will remain on the Cell command bar until the Excel application
ends, even if you close the workbook that created it. If you want the
control to be accessible only when that one workbook is active, use code
like the following in the ThisWorkbook code module:


Private Const C_TAG = "MyFormatPainter"

Private Sub Workbook_Activate()

Dim Ctrl As Office.CommandBarControl
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
If Ctrl Is Nothing Then
Set Ctrl = CreateControl
End If
Ctrl.Visible = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars.FindControl(Tag:=C_TAG).Delete
End Sub

Private Sub Workbook_Deactivate()
On Error Resume Next
Application.CommandBars.FindControl(Tag:=C_TAG).Visible = False
End Sub

Private Function CreateControl() As Office.CommandBarControl
Dim C As Office.CommandBarControl
Set C = Application.CommandBars("Cell").Controls.Add(ID:=108,
temporary:=True)
C.Tag = C_TAG
Set CreateControl = C
End Function



--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)