เขียนCode VBA เพื่อดึงภาพแล้วแต่ภาพไม่มา

[widtara]

สวัสดีค่ะอาจาร์ย หนูมีไฟล์หนึ่ง 133428540.xls ได้เขียนโค้ด VBA แล้วแต่คำสั่งไม่ทำงาน รบกวนอาจารย์ช่วยดูให้หน่อยค่ะ

[snasui]

ค่อย ๆ ถามตอบกันไปนะครับ

จากไฟล์ที่แนบมา สำหรับ Code นี้เข้าใจว่าอย่างไรครับ

Code: Select all

With Worksheets("Sheet1")
    Set ra = .Range("G4", .Range("D65536").End(xlUp).Offset(0, 1))
 End With

[widtara]

With Worksheets("Sheet1")
Set ra = .Range("G4", .Range("D65536").End(xlUp).Offset(0, 1))
End With

น่าจะให้คำสั่งทำงานใน "D" ทุกบรรทัด เช่นใส่ข้อมูล D4 ภาพก็ออกที่ G4 แล้วก็เลื่อนลงมาเรื่อยๆหรือเปล่าค่ะ หนูต้องการให้เป็นอย่างนี้นะค่ะ

[widtara]

With Worksheets("Sheet1")
Set ra = .Range("G4", .Range("D65536").End(xlUp).Offset(0, 1))
End With

น่าจะให้คำสั่งทำงานใน "D" ทุกบรรทัด เช่นใส่ข้อมูล D4 ภาพก็ออกที่ G4 แล้วก็เลื่อนลงมาเรื่อยๆหรือเปล่าค่ะ หนูต้องการให้เป็นอย่างนี้นะค่ะ

อาจารย์ค่ะ หนูลองนำ code เก่าที่อาจารย์เขียนไว้มาปรับ ได้ ไฟล์ Rev 01. ตอนนี้ภาพโชว์แล้วแต่บรรทัดต่อมาภาพยังไม่มาค่ะช่วยดูให้หน่อยค่ะ

Sub ShowPicture00()
Dim r As String
r = Range("F4").Value
On Error Resume Next

With Worksheets("Sheet1")
Set ra = .Range("G4", .Range("D65536").End(xlUp).Offset(0, 1))
End With


ActiveSheet.Shapes(1).Delete
Range("G4").Select
ActiveSheet.Pictures.Insert("R:\SQA SupplierImprovementPjt\History Parts Quality Project\Pic\" & r & ".JPG").Select
Selection.ShapeRange.ScaleWidth 0.14, _
msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.14, _
msoFalse, msoScaleFromTopLeft
Range("F4").Select
End Sub
Sub ShowPicture()
Dim r As String
Dim imgIcon
On Error Resume Next

With Worksheets("Sheet1")
Set ra = .Range("G4", .Range("D65536").End(xlUp).Offset(0, 1))
End With

ActiveSheet.Shapes(1).Delete
r = Range("F4").Value
With Range("G4")
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="R:\SQA SupplierImprovementPjt\History Parts Quality Project\Pic\" & r & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
Width:=180, Height:=138)
End With
Set imgIcon = Nothing
End Sub

[widtara]

ลืมแนบไฟล์มาให้ค่ะ

[snasui]

With Worksheets("Sheet1")
Set ra = .Range("G4", .Range("D65536").End(xlUp).Offset(0, 1))
End With

น่าจะให้คำสั่งทำงานใน "D" ทุกบรรทัด เช่นใส่ข้อมูล D4 ภาพก็ออกที่ G4 แล้วก็เลื่อนลงมาเรื่อยๆหรือเปล่าค่ะ หนูต้องการให้เป็นอย่างนี้นะค่ะ

ยังเข้าใจไม่ถูกต้องครับ

ความหมายคือให้ตัวแปร ra มีค่าเท่ากับช่วงเซลล์โดยเริ่มที่ G4 จนถึงค่าสุดท้ายที่ไม่เป็นค่าว่างในคอลัมน์ E ลองทำความเข้าใจตามด้านล่างครับ

• .Range("D65536") คือเริ่มที่ D65536
• .Range("D65536").End(xlUp) คือเริ่มที่ D65536 แล้วขึ้นไปยังเซลล์แรกที่พบข้อมูล
• .Range("D65536").End(xlUp).Offset(0, 1) คือเริ่มที่ D65536 แล้วขึ้นไปยังเซลล์แรกที่พบข้อมูลแล้วไปทางขวา 1 คอลัมน์ จึงกลายเป็นคอลัมน์ E

จะเห็นว่าการเขียน Code เช่นนี้ยังไม่ใช่ช่วงเซลล์ที่ต้องการจะกำหนดตัวแปร เนื่องจากควรจะเป็นช่วงเซลล์ที่เริ่มด้วย D2 (ดูจากไฟล์แรกที่แนบมา)

สำหรับ Procedure ที่ชื่อ Sub ShowPicture00() ไม่มีการ Loop จึงเป็นปกติที่แสดงในเซลล์เดียว ถ้าต้องการ Loop ให้ทำความเข้าใจ Procedure ที่ชื่อ ShowPicture ลองปรับ Code โดยทำความเข้าใจตามด้านบน และศึกษาการใช้ Offset ตามความเห็นนี้ viewtopic.php?p=11360#p11360 ติดตรงไหนก็ยกมาถามได้เรื่อย ๆ ครับ

[widtara]

อาจารย์ค่ะ ทดลองแล้วมันยังไม่ได้อยู่ดีค่ะ หนูไปเอา code vba
จาก
http://www.snasui.com/viewtopic.php?f=3&t=324/

มาปรับดูใหม่ เปลี่ยนแต่ที่อยู่ R:\ ค่ะ

For Each r In ra
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="R:\SQA SupplierImprovementPjt\History Parts Quality Project\Pic\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
Width:=r.Width, Height:=r.Height)
Next r

คำสั่งก็ไม่ทำงานเลย แม้แต่บรรทัดเดียว

อาจารย์ช่วยทำไฟล์ให้โหลดดูหน่อยค่ะ ค่า enable trust center logging ก็ เซตแล้ว หรือว่าต้องใช้ .xlsm ค่ะ

ดูตัวอย่างมาจาก ดึงรูปจาก Drive D.xls

[snasui]

ที่บอกว่าคำสั่งไม่ทำงานเลยคงจะไม่ใช่ครับ

เนื่องจากไปบังคับว่าแม้จะมีการผิดพลาดก็ไม่แสดงการผิดพลาดขึ้นมาด้วยคำสั่ง

Code: Select all

On Error Resume Next

หากต้องการให้แสดงว่าผิดพลาดตรงไหนก็ Mark บรรทัดนี้ให้เป็น Comment แล้วลอง Run Code ดูครับ

ดู Code แล้วน่าจะทำงานได้ตามต้องการ อาจจะเป็นตำแหน่งของไฟล์ที่จะให้นำมาแสดง หากเปลี่ยนตำแหน่งแล้วแสดงได้ก็ไม่ต้องสงสัยเรื่องอื่นแล้วละครับ

สำหรับการวาง Code แล้วให้แสดงเป็น Code ดูข้อ 5 จากโพสต์นี้ครับ http://www.snasui.com/viewtopic.php?f=3&t=1354

[widtara]

ได้แล้วค่ะ
'On Error Resume Next

ใส่ ' ตัวนี้เข้าไปคำสั่งทำงานเลย แต่ยังไม่เข้าใจว่าเมื่อคำสั่งก็ถูก แล้วทำไมระบบมองเป็น error เมื่อมีคำสั่ง
On Error Resume Next ระบบถึงไม่ทำงานค่ะ

[snasui]

อ่านความเห็นที่ผมตอบไปอย่างช้า ๆ ครับ โดยเฉพาะท่อนนี้

ที่บอกว่าคำสั่งไม่ทำงานเลยคงจะไม่ใช่ครับ <== หมายถึงว่าทำงานอยู่ครับ

เนื่องจากไปบังคับว่าแม้จะมีการผิดพลาดก็ไม่แสดงการผิดพลาดขึ้นมาด้วยคำสั่ง

Code: Select all

On Error Resume Next

ก็เลยไม่เห็นว่ามันผิดพลาด เพราะถูกบังคับไม่ให้แสดงค่าผิดพลาดออกมา

ส่วนคำสั่งถูกแ้ล้วและถูกมองเป็น Error นั้น ผมคงต้องเห็นจังหวะนั้นถึงจะวินิจฉัยได้ครับ