2012 m. rugsėjo 6 d., ketvirtadienis
Read picture from file to Excel shape from cell text
Sub InsertPic()
Dim fname
Dim DrObj
Dim Pict
Set DrObj = ActiveSheet.DrawingObjects
For Each Pict In DrObj
If Left(Pict.Name, 7) = "Picture" Then
Pict.Select
Pict.Delete
End If
Next
On Error GoTo ErrNoPhoto:
fname = ActiveCell.Text
ActiveSheet.Pictures.Insert (fname)
Set DrObj = ActiveSheet.DrawingObjects
For Each Pict In DrObj
If Left(Pict.Name, 7) = "Picture" Then
Pict.Select
With Selection
.ShapeRange.Top = ActiveCell.Top
.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width
.ShapeRange.Height = 120#
.ShapeRange.Rotation = 0#
End With
End If
Next
Exit Sub
ErrNoPhoto:
MsgBox "No pic!"
Exit Sub
End Sub
Užsisakykite:
Pranešimai (Atom)