Put a picture in a text box without selecting it?
Dave, thanks for this one also, works fine
"Dave Peterson" wrote in message
...
This worked ok for me.
Just a warning...
if that number in G1 that is the name of the file, you may have to format
it to
show any leading 0's.
You may need to use something like:
& format(.range("g1").value, "00000") & ".jpg"
Option Explicit
Sub ShowPictures()
Dim TBox As TextBox
Dim myFileName As String
Dim TestStr As String
With ActiveSheet
Set TBox = .TextBoxes("text box 21")
myFileName = Application.DefaultFilePath _
& "\My Pictures\Carousels" & "\" _
& .Range("G1").Value & ".jpg"
End With
With TBox
.Characters.Text = ""
With .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With .ShapeRange
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 64
.Line.BackColor.RGB = RGB(255, 255, 255)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.BackColor.RGB = RGB(255, 255, 255)
TestStr = ""
On Error Resume Next
TestStr = Dir(myFileName)
On Error GoTo 0
If TestStr = "" Then
MsgBox Prompt:="No Picture Available", _
Title:="Error Retrieving Picture", _
Buttons:=vbOKOnly
Else
.Fill.UserPicture picturefile:=myFileName
End If
End With
End With
End Sub
Paul B wrote:
Can this be done without selecting the text box? I am using it to put a
picture in a text box, the picture number is in cell G1. Or is there a
better way?
Using Excel 2003
Thanks
Sub ShowPictures()
ActiveSheet.Shapes("Text Box 21").Select
Selection.Characters.Text = ""
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
On Error GoTo NoPic
Selection.ShapeRange.Fill.UserPicture _
Application.DefaultFilePath & "\My Pictures\Carousels" & "\" &
Range("G1").Value & ".jpg"
On Error GoTo 0
Exit Sub
NoPic:
MsgBox Prompt:="No Picture Available", _
Title:="Error Retrieving Picture", _
Buttons:=vbOKOnly
On Error GoTo 0
End Sub
--
Dave Peterson
|