ต้องการให้ VBA แทรกรูปมากกว่า 1 column
Posted: Wed Aug 26, 2020 5:21 pm
ถ้าใส่ชื่อรูปที่ Column B เพื่อให้แสดงที่ column C แล้ว
อยากให้ ใส่ชื่อรูปที่ Column E เพื่อให้แสดงที่ column F ด้วย ต้องแก้ไข code ยังไงคะ
ไฟล์มีขนาดใหญ่เกินไป ไม่สามารถแนบได้ค่ะ
Sub ShowPicture()
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("Sheet1")
Set ra = .Range("C6", .Range("B" & .Rows.Count) _
.End(xlUp).Offset(0, 1))
End With
For Each obj In ActiveSheet.Shapes
If Left(obj.Name, 4) = "Pict" Then
obj.Delete
End If
Next obj
For Each r In ra
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", _
LinkToFile:=False, saveWithDocument:=True, _
Left:=r.Left, Top:=r.Top, _
Width:=r.Width, Height:=r.Height)
Next r
End Sub
อยากให้ ใส่ชื่อรูปที่ Column E เพื่อให้แสดงที่ column F ด้วย ต้องแก้ไข code ยังไงคะ
ไฟล์มีขนาดใหญ่เกินไป ไม่สามารถแนบได้ค่ะ
Sub ShowPicture()
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("Sheet1")
Set ra = .Range("C6", .Range("B" & .Rows.Count) _
.End(xlUp).Offset(0, 1))
End With
For Each obj In ActiveSheet.Shapes
If Left(obj.Name, 4) = "Pict" Then
obj.Delete
End If
Next obj
For Each r In ra
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", _
LinkToFile:=False, saveWithDocument:=True, _
Left:=r.Left, Top:=r.Top, _
Width:=r.Width, Height:=r.Height)
Next r
End Sub
กรุณาโพสต์ Code มาใหม่พร้อมแนบไฟล์ประกอบครับ
