Copy Fill To Other Shapes

I wrote a macro to apply a bitmap pattern fill to all the shapes.

If I changed the scale on one panel I would like to copy that new fill to the other panels. I'm trying to do this with one "sync" button on a user form.

Sub ApplyTexture()

  Dim s As Shape
  Dim sr As ShapeRange
  
  Set sr = ActiveSelectionRange
  
  For Each s In sr.Shapes
    
    'Apply Texture
    s.Style.Fill.LoadFill ("C:\Users\jchestnut\Documents\Corel\Corel Content\Fills\CoolerWrap Wood 1.fill")
    
    'Remove Outline
    If s.Outline.Width > 0 Then
      s.Outline.SetNoOutline
    ElseIf s.Outline.Width = 0 Then
      s.Outline.SetProperties 1
    End If
    
  Next s
  
End Sub
Parents
  • You can apply the fill the an entire ShapeRange. Here is an example that takes the fill from the first shape in the ShapeRange and applies it to the entire ShapeRange. 

    Sub ApplyFillFromFirstShape()
        Dim sr As ShapeRange
        
        Set sr = ActiveSelectionRange
        
        sr.ApplyFill sr.FirstShape.Fill
    End Sub
    


    Happy coding, 

    -Shelby

Reply Children
No Data