Snasui Excel Forum

Code: Select all

Sub ShowPicture00()
    Dim r As String
    r = TextBox1.Text <> "" <<ติด Error บรรทัดนี้ครับ อาจารย์
    On Error Resume Next
    ActiveSheet.Shapes(1).Delete
    Image1.Select
    ActiveSheet.Pictures.Insert("D:\" & r & ".JPG").Select
    Selection.ShapeRange.ScaleWidth 0.14, _
        msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.14, _
        msoFalse, msoScaleFromTopLeft
    Image1.Select
End Sub

Code: Select all

Private Sub CommandButton1_Click()
Call ShowPicture00
End Sub

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range) << ผมต้องเปลี่ยนเป็นอะไรครับอาจารย์ Text หรือ ครับ 

Code: Select all

If Target.Address = "$F$4" Then
    Call ShowPicture
End If

Code: Select all

If Target.Address = "$F$4" Then
    Call ShowPicture
End If

Code: Select all

If Target.Address = "TextBox1" Then
    Call ShowPicture
End If

Code: Select all

Sub ShowPicture00()
    Dim r As String
    r = TextBox1.Text <> ""
    On Error Resume Next
    ActiveSheet.Shapes(1).Delete
    Image1.Select
    ActiveSheet.Pictures.Insert("D:\" & r & ".JPG").Select
    Selection.ShapeRange.ScaleWidth 0.14, _
        msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.14, _
        msoFalse, msoScaleFromTopLeft
    Image1.Select
End Sub
Sub ShowPicture()
Dim r As String
Dim imgIcon
On Error Resume Next
    ActiveSheet.Shapes(1).Delete
r = TextBox1.Text <> ""
With Image1
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\" & r & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
    Width:=180, Height:=138)
End With
Set imgIcon = Nothing
End Sub

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "TextBox1" Then
    Call ShowPicture
End If
Application.EnableEvents = True
End Sub