ขอคำแนะนำ CodeVB แทรกภาพแล้วฝังไว้ในไฟล์

[tigerwit]

ผมทำไฟล์แทรรูปภาพใน excel โดย CodeVB

Code: Select all

Sub InsImge()
Const strPath As String = "C:\"
Dim Imge
Dim ImgFileFormat As String
Dim i As Integer
Dim obj As Object

    For Each obj In ActiveSheet.Shapes
        If obj.Name = "picture 46" Then
            i = 1
        End If
    Next obj
    If i = 1 Then
           ActiveSheet.Unprotect Password:="1"
    Range("B1").Select
    ActiveSheet.Shapes("picture 46").Delete
    Range("B1").Select
    End If
    
    ActiveSheet.Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True

       Sheets("Logo").Select
        ChDrive strPath
        ImgFileFormat = "Image Files (*.jpg;*.png),*.jpg;*.png"
        Imge = Application.GetOpenFilename(ImgFileFormat)
If Imge <> "False" Then
        ActiveSheet.Unprotect Password:="1"
            Range("B1").Select
                ActiveSheet.Pictures.Insert(Imge).Name = "picture 46"
            Range("A1").Select
                Selection.Offset(0, 1).Select
                    ActiveSheet.Shapes("picture 46").Select
                    With Selection
                            .Height = ActiveCell.Height - 2
                            .ShapeRange.IncrementTop 1
                             .ShapeRange.IncrementLeft (ActiveCell.Width - Selection.Width) / 2
                    End With
            Range("D2").Select
    
    ActiveSheet.Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True

    End If
End Sub

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

[snasui]

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

Code: Select all

Sub InsImge()
    Const strPath As String = "C:\"
    Dim Imge
    Dim ImgFileFormat As String
    Dim i As Integer
    Dim obj As Object
    
    ActiveSheet.Unprotect Password:="1"
    With ActiveSheet
        For Each obj In .Shapes
            If obj.Name = "picture 46" Then
    '            i = 1
                obj.Delete
                Exit For
            End If
        Next obj
    End With
    
    
'    If i = 1 Then
'        ActiveSheet.Unprotect Password:="1"
'        Range("B1").Select
'        ActiveSheet.Shapes("picture 46").Delete
'        Range("B1").Select
'    End If
    
'    ActiveSheet.Protect Password:="1", DrawingObjects:=True, _
        Contents:=True, Scenarios:=True
    
    Sheets("Logo").Select
    ChDrive strPath
    ImgFileFormat = "Image Files (*.jpg;*.png),*.jpg;*.png"
    Imge = Application.GetOpenFilename(ImgFileFormat)
    
    If Imge <> "False" Then
'        ActiveSheet.Unprotect Password:="1"
        Range("B1").Select
'        ActiveSheet.Pictures.Insert(Imge).Name = "picture 46"
'        Range("A1").Select
'        Selection.Offset(0, 1).Select
'        ActiveSheet.Shapes("picture 46").Select
        
        With Selection
            Set Imge = ActiveSheet.Shapes.AddPicture( _
                Filename:=Imge, _
                LinkToFile:=False, saveWithDocument:=True, _
                Left:=Selection.Left, Top:=Selection.Top, _
                Width:=Selection.Width, Height:=Selection.Height)
                Imge.Name = "picture 46"
'            .Height = ActiveCell.Height - 2
'            .ShapeRange.IncrementTop 1
'            .ShapeRange.IncrementLeft (ActiveCell.Width - Selection.Width) / 2
        End With
        
        Range("D2").Select
        ActiveSheet.Protect Password:="1", DrawingObjects:=True, _
            Contents:=True, Scenarios:=True
    End If
End Sub

[tigerwit]

ขอบคุณครับ