Hi all. Is there a way to fix these cheks so you can avoid the confirmation button?
I mean a way to configure copy properties of line color and fill only once and avoid the confirmation step any time I want to copy these properties.On repetitive task it means a lot of cliks.
Thanks in advance.
You could try using a macro. This one copies the fill, outline color and outline pen properties from the last-selected object in the selection to the other objects in the selection
Sub copy_properties_fill_and_outline() Dim sr As ShapeRange Dim sToCopyFrom As Shape If Not ActiveDocument Is Nothing Then Set sr = ActiveSelectionRange If sr.Count > 1 Then Set sToCopyFrom = sr.FirstShape sr.Remove sr.IndexOf(sToCopyFrom) sr.CopyPropertiesFrom sToCopyFrom, cdrCopyFill sr.CopyPropertiesFrom sToCopyFrom, cdrCopyOutlineColor sr.CopyPropertiesFrom sToCopyFrom, cdrCopyOutlinePen Else MsgBox "Two or more objects must be selected.", vbExclamation, "Copy Fill and Outline" End If Else MsgBox "No document is active.", vbExclamation, "Copy Fill and Outline" End If End Sub
PERFECT!!! Exactly what I need. Many Thanks. Good life for you.
If that does what you need, then this is some of the same code, but with some other stuff added to make the operations performed show up as a single item in the Undo list. It also has some error handling.
Sub copy_properties_fill_and_outline() Dim sr As ShapeRange Dim sToCopyFrom As Shape Dim blnHaveCommandGroup As Boolean If Not ActiveDocument Is Nothing Then Set sr = ActiveSelectionRange If sr.Count > 1 Then EventsEnabled = False Optimization = True ActiveDocument.BeginCommandGroup "Copy Fill & Outline" blnHaveCommandGroup = True Set sToCopyFrom = sr.FirstShape sr.Remove sr.IndexOf(sToCopyFrom) sr.CopyPropertiesFrom sToCopyFrom, cdrCopyFill sr.CopyPropertiesFrom sToCopyFrom, cdrCopyOutlineColor sr.CopyPropertiesFrom sToCopyFrom, cdrCopyOutlinePen Else MsgBox "Two or more objects must be selected.", vbExclamation, "JQ Copy Fill and Outline" End If Else MsgBox "No document is active.", vbExclamation, "JQ Copy Fill and Outline" End If ExitSub: If blnHaveCommandGroup Then ActiveDocument.EndCommandGroup Optimization = False EventsEnabled = True Refresh End If Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description, , "JQ Copy Fill and Outline" Resume ExitSub End Sub
I really apprecciate your commitment. Thanks again.