The following code is perfect.
Sub Macro1()
'Delete all shapes
For i = ActiveSheet.Shapes.Count To 1 Step -1
ActiveSheet.Shapes(i).Delete
Next
'Add first rectangle
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left:=0, Width:=300, Top:=0, Height:=300)
.Name = "Shape1"
.Fill.UserPicture ".jpg"
End With
'Add second rectangle
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left:=350, Width:=500, Top:=0, Height:=300)
.Name = "Shape2"
.TextFrame2.TextRange.Font.Size = 80
.TextFrame2.TextRange.Characters.Text = "StackOverFlow"
With .TextFrame2.TextRange.Font.Fill
.UserPicture ".jpg"
.TextureTile = msoTrue
.TextureAlignment = msoTextureCenter
End With
End With
End Sub
I was hoping to set the fill property of one shape to the fill property of another shape but it doesn't seem possible.
Please run the following code in order to see the error line.
Sub Macro2()
'Delete all shapes
For i = ActiveSheet.Shapes.Count To 1 Step -1
ActiveSheet.Shapes(i).Delete
Next
'Add first rectangle
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left:=0, Width:=300, Top:=0, Height:=300)
.Name = "Shape1"
.Fill.UserPicture ".jpg"
End With
'Add second rectangle
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left:=350, Width:=500, Top:=0, Height:=300)
.Name = "Shape2"
.TextFrame2.TextRange.Font.Size = 80
.TextFrame2.TextRange.Characters.Text = "StackOverFlow"
With .TextFrame2.TextRange.Font.Fill
'How do I set shape.fill.userpicture from one shape to another? I have tried the following code without success.
.UserPicture ActiveSheet.Shapes("Shape1").UserPicture
.TextureTile = msoTrue
.TextureAlignment = msoTextureCenter
End With
End With
End Sub
The following link doesnt help because my question is regarding filling a text not filling a shape.
How do I set shape.fill.userpicture from one shape to another