VBA ค้นหารูปจาก 2 แห่ง

[notta_nobi]

ผมมีเรื่องรบกวนทุกท่านเกี่ยวกับ VBA ครับ
ออกตัวก่อนนะครับว่าผมเองเขียน VBA ไม่เป็นนะครับ
แต่ผมอ่านวิธีค้นหาภาพด้วย VBA ในบอร์ดนี้แล้วลองปรับนิดหน่อยก็สามารถใช้ได้
ปัจจุบันผมใช้ Code นี้อยู่ครับ

Code: Select all

Sub ShowPicture1()
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("G4", .Range("F65536").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:="\\AA-AA-sv\PIC\EMP_Picture\Current\" & 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

หากว่าผมต้องการเพิ่มเงื่อนไขว่าหากค้นภาพที่ "\\AA-AA-SV\PIC\EMP_Picture\Current\" ไม่เจอให้ค้นหาที่ "\\BB-BB-SV\PIC\EMP_Picture\Current\" เพิ่มเติม ควรจะเขียน VBA เพิ่มตรงไหน อย่างไรครับ

รบกวนทุกท่านด้วยครับ

[snasui]

การใช้ Code VBA จำเป็นต้องปรับเองได้บ้าง กรณียกมาเฉย ๆ ผมไม่ถือว่าได้ลองปรับมาแล้ว

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

[notta_nobi]

อาจารย์ครับ
เดิมทีผมได้แนวคิดมาจาก wordpress/?p=417 ครับ
Code เดิมที่เขียนไว้

Code: Select all

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("G4", .Range("F65536").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

ผมปรับเฉพาะในส่วนของแหล่งที่เก็บรูปภาพครับ จาก Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
เป็น Filename:="\\AA-AA-sv\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
เพื่อให้สามารถเชื่อมโยงไปยัง Server ที่จัดเก็บรูปครับ

แต่เงื่อนไขที่ผมต้องการเพิ่มคือ
หากค้นภาพที่ "\\AA-AA-SV\PIC\EMP_Picture\Current\" ไม่เจอ
ให้ค้นหาที่ "\\BB-BB-SV\PIC\EMP_Picture\Current\" เพิ่มเติม

ควรจะเขียน VBA เพิ่มตรงไหน อย่างไรครับ

ขอบคุณครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code
For Each r In ra
    If Dir("\\AA-AA-sv\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg") <> "" Then
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="\\AA-AA-sv\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
    Else
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="\\BB-BB-SV\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
    End If
Next r
'Other code

[notta_nobi]

ขอบคุณมากครับ
ผมปรับ Code ใหม่ตามที่อาจาร์ยแนะนำมาสามารถใช้งานได้ดีครับ
Code ใหม่ที่ผมปรับเป็นตามนี้ครับ (เผื่อท่านอื่นที่อยากนำไปประยุกต์ใช้ครับ)

Code: Select all

Sub ShowPicture1()
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("G4", .Range("F65536").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
    If Dir("\\AA-AA-sv\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg") <> "" Then
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="\\AA-AA-sv\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
    Else
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="\\BB-BB-SV\PIC\EMP_Picture\Current\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
    End If
Next r
End Sub