Craig Johnson
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.AddP icture(Fil eName:="C: \Documents and Settings\JOHN10\My Documents\My Pictures\Frown.bmp", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, (msoShapeS mileyFace, 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
-----
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.AddP
.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
If you want to anchor it to the selected picture and adjust its dimension then use this modification.
With ActiveDocument.Shapes.AddP icture("C: \Documents and Settings\JOHN10\My Documents\My Pictures\Frown.bmp", 0, 1, 0, 0, shp.Width / 13, shp.Height / 7, rng)
With ActiveDocument.Shapes.AddP
ASKER
Would like to place the frown face at the same location as the smiley face....thus I can choose.
ActiveDocument.Shapes.AddS hape(msoSh apeSmileyF ace, 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?
ActiveDocument.Shapes.AddS
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.AddP icture("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.AddS hape(msoSh apeSmileyF ace, 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
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.AddP
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.AddS
.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
ASKER
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.AddP icture("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
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.AddP
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)
With shp1
.Left = 450
.Line.ForeColor.RGB = RGB(186, 14, 29)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
With ActiveDocument.Shapes.AddS
.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.AddP
.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