Link to home
Start Free TrialLog in
Avatar of Craig Johnson
Craig JohnsonFlag for United States of America

asked on

Frown Face Question...

Any thoughts why this does not work?

-----

Sub Test()

Dim shp As Object, rng As Range
If Selection.Type = 7 Or Selection.Type = 8 Then
    If Selection.Type = 7 Then
        Set shp = Selection.InlineShapes(1)
        Set rng = shp.Range
    Else
        Set shp = Selection.ShapeRange(1)
        Set rng = shp.Anchor
    End If
    With ActiveDocument.Shapes.AddPicture(FileName:="C:\Documents and Settings\JOHN10\My Documents\My Pictures\Frown.bmp", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue,(msoShapeSmileyFace, 475, 20, shp.Width / 13, shp.Height / 7, rng)
        .Line.ForeColor.RGB = RGB(186, 14, 29)
        .Line.Weight = 3#
        .Line.Visible = msoTrue
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.54, msoFalse, msoScaleFromTopLeft
    End With
Else
    MsgBox "Please select a picture"
End If

End Sub
Avatar of R_Rajesh
R_Rajesh

You cant add them at the same time. Insert them one at a time...

With ActiveDocument.Shapes.AddShape(msoShapeSmileyFace, 475, 20, shp.Width / 13, shp.Height / 7, rng)
   
        .Line.ForeColor.RGB = RGB(186, 14, 29)
        .Line.Weight = 3#
        .Line.Visible = msoTrue
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.54, msoFalse, msoScaleFromTopLeft
    End With
   
    With ActiveDocument.Shapes.AddPicture(FileName:="C:\Documents and Settings\JOHN10\My Documents\My Pictures\Frown.bmp", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue)
        .Line.ForeColor.RGB = RGB(186, 14, 29)
        .Line.Weight = 3#
        .Line.Visible = msoTrue
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.54, msoFalse, msoScaleFromTopLeft
    End With
If you want to anchor it to the selected picture and adjust its dimension then use this modification.

With ActiveDocument.Shapes.AddPicture("C:\Documents and Settings\JOHN10\My Documents\My Pictures\Frown.bmp", 0, 1, 0, 0, shp.Width / 13, shp.Height / 7, rng)
Avatar of Craig Johnson

ASKER

Would like to place the frown face at the same location as the smiley face....thus I can choose.

ActiveDocument.Shapes.AddShape(msoShapeSmileyFace, 475, 20, shp.Width / 13, shp.Height / 7, rng)

I tried to put these settings.....475, 20 into the code you provided, but it did not work....ideas?

This should place both of them side by side...

Sub Test()
Dim shp As Object, rng As Range, shp1 As Object
If Selection.Type = 7 Or Selection.Type = 8 Then
    If Selection.Type = 7 Then
        Set shp = Selection.InlineShapes(1)
        Set rng = shp.Range
    Else
        Set shp = Selection.ShapeRange(1)
        Set rng = shp.Anchor
    End If
   Set shp1 = ActiveDocument.Shapes.AddPicture("C:\Documents and Settings\JOHN10\My Documents\My Pictures\Frown.bmp", 0, 1, 0, 0, shp.Width / 13, shp.Height / 7, rng)
   With shp1
        .Line.ForeColor.RGB = RGB(186, 14, 29)
        .Line.Weight = 3#
        .Line.Visible = msoTrue
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.54, msoFalse, msoScaleFromTopLeft
    End With
    With ActiveDocument.Shapes.AddShape(msoShapeSmileyFace, shp1.Left + shp1.Width, 0, shp.Width / 13, shp.Height / 7, rng)
   
        .Line.ForeColor.RGB = RGB(186, 14, 29)
        .Line.Weight = 3#
        .Line.Visible = msoTrue
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.54, msoFalse, msoScaleFromTopLeft
    End With

Else
    MsgBox "Please select a picture"
End If

End Sub
Here is my current code...

I would like the frown only on the upper righthand side of the screen....please

CWJ

----------------------------------
Sub Frown_Face()
'
' This creates a frown face

Dim shp As Object, rng As Range, shp1 As Object
If Selection.Type = 7 Or Selection.Type = 8 Then
    If Selection.Type = 7 Then
        Set shp = Selection.InlineShapes(1)
        Set rng = shp.Range
    Else
        Set shp = Selection.ShapeRange(1)
        Set rng = shp.Anchor
    End If
   Set shp1 = ActiveDocument.Shapes.AddPicture("C:\Documents and Settings\JOHNC04\My Documents\My Pictures\Frown.bmp", 0, 1, 0, 0, shp.Width / 13, shp.Height / 7, rng)
   With shp1
        .Line.ForeColor.RGB = RGB(186, 14, 29)
        .Line.Visible = msoFalse
        .Fill.Transparency = 1#
        .ScaleWidth 0.73, msoFalse, msoScaleFromTopright
        .ScaleHeight 0.54, msoFalse, msoScaleFromTopright
    End With

Else
    MsgBox "Please select a picture"
End If

End Sub
use the pictures left and top property to position it

With shp1
        .Left = 450
        .Line.ForeColor.RGB = RGB(186, 14, 29)
ASKER CERTIFIED SOLUTION
Avatar of R_Rajesh
R_Rajesh

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial