สอบถามเรื่องการแทรกรูปโดยใช้ VBA คะ

[sunnievitva]

พอดีตามมาจากบล็อคนี้คะ

http://snasui.blogspot.com/2011/05/folder-excel.html

แก้ Code จน Run ออกมาได้ตามที่ต้องการแล้วคะ ตามนี้


Sub ShowPicture()
Dim wipcode As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("WIP Form")
Set ra = .Range("E16")
Set wipcode = .Range("Y2")
End With
For Each obj In ActiveSheet.Shapes
If Left(obj.Name, 4) = "Pict" Then
obj.Delete
End If
Next obj

Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\Dropbox\KongSiri\Product Specification\WIP Drawing\JPG\" & wipcode.Value & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=ra.Left, Top:=ra.Top, _
Width:=400, Height:=400)

End Sub




ติดแค่ รูปที่ขึ้นมา ต้องกำหนดขนาด เพราะลองไม่กำหนด มันขึ้นเท่าไซส์เซลล์เลยคะ (จริงๆแล้ว รูปที่ทำเอาไว้ กำหนดขนาดไว้แล้ว) อยากได้รูปเท่าขนาดรูปจริง 100% เลยคะ ไม่ทราบว่าต้องกำหนดค่ายังไงคะ

ปล. รูปที่จะแทรก เป็นขนาด 1181 x 1181 pixel คะ หรือว่า 15 x 15 cm

ขอบคุณคะ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub ShowPicture()
    Dim p As String
    Dim wipcode As Range
    With Worksheets("WIP Form")
        Set ra = .Range("E16")
        Set wipcode = .Range("Y2")
    End With
    For Each obj In ActiveSheet.Shapes
        If Left(obj.Name, 4) = "Pict" Then
            obj.Delete
        End If
    Next obj
    p = "D:\Dropbox\KongSiri\Product Specification\WIP Drawing\JPG\" & wipcode.Value & ".jpg"
    With ActiveSheet.Pictures.Insert(p)
        .Left = ra.Left
        .Top = ra.Top
    End With
End Sub

[sunnievitva]

ใช้ได้ละคะ ขอบคุณมากคะ

[keroro]

รบกวนถามสูตรจากลิ้งด้านล่างหน่อยค่ะ
http://snasui.blogspot.com/2011/05/folder-excel.html
ถ้าต้องการให้มีการลบภาพเดิม ในการคลิกครั้งถัดไป ต้องเพิ่มสูตรอย่างไรคะ

ขอบคุณค่ะ

[snasui]

เขียน Code ปรับมาเองดูก่อน ติดตรงไหนแล้วค่อยถามกันต่อครับ