รบกวนอาจารย์ ช่วยเรื่อง Code VB ตรวจสอบการลบและแทรกรูปภาพด้ว

[tigerwit]

ข้อมูลรายละเอียดตามไฟล์ที่แนบมา

1. ถ้าไม่มีรูปตราโรงเรียน(picture 46) แล้วผู้ใช้โปรแกรมไปคลิกปุ่มลบตราโรงเรียน ให้โปรแกรมแจ้งว่าไม่มีรูปให้ลบ แล้วกลับมาที่หน้าเดิม
2. กรณีมีตราโรงเรียนอยู่แล้ว แล้วผู้ใช้โปรแกรมคลิกปุ่มเปลี่ยนตราโรงเรียนโดยไม่ลบรูปออกก่อน ให้โปรแกรมตรวจสอบ แล้วแจ้งว่ามีรูปตราโรงเรียนอยู่ ให้ลบรูปออกก่อน

[snasui]

ไม่ทราบกระทู้นี้ได้คำตอบแล้วยังครับ viewtopic.php?f=3&t=1662

[tigerwit]

ได้ดูแล้วครับ
แต่.....บอกตามตรงเลยครับว่า ปึก แป้นปีก งงมาก ๆ
ก็เลยไปไม่เป็น สุดท้ายก็...หยุดพักไว้

สรุปว่าคำถามในกระทู้นี้ ต้องเข้าใจกระทู้นั้นด้วยใช่ไหมครับ
จะได้กลับไปพยายามศึกษาอีกรอบ

[snasui]

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

Code: Select all

Sub delpic()
' Macro001 Macro
' แมโครถูกบันทึก ณ วันที่ 25/10/2011 โดย หมู ภูดินแดง
    If ActiveSheet.Shapes("Picture 46") Is Nothing Then
        MsgBox "ไม่มีรูปให้ลบ"
        Exit Sub
    End If
    If MsgBox("คุณต้องการลบตราโรงเรียน?", 36, "ยืนยันการลบ") = 6 Then
        ActiveSheet.Shapes("Picture 46").Select
        Selection.Delete
         Cancel = True
    End If
End Sub
Sub ChPic()
'
' Macro005 Macro
' แมโครถูกบันทึก ณ วันที่ 25/10/2011 โดย หมู ภูดินแดง
    Dim Ans As Integer
    If Not ActiveSheet.Shapes("Picture 46") Is Nothing Then
        Ans = MsgBox("มีรูปอยู่แล้วต้องการลบหรือไม่", vbYesNo)
    End If
    If Ans = vbYes Then
        ActiveSheet.Shapes("picture 46").Delete
        ActiveSheet.Pictures.Insert("C:\PP51\pic\pd.jpg").Name = "picture 46"
        ActiveSheet.Shapes("picture 46").Select
        Range("B1").Select
    End If
End Sub

[tigerwit]

Err ครับ
ตอนที่มีรูปตราโรงเรียน โปรแกรมรันได้
พอลบรูปไปแล้ว
และคลิกที่ปุ่ม โปรแกรมมีปัญหาครับ

[tigerwit]

ไฟล์ครับ

[snasui]

ลองปรับเป็น Loop เพื่อหาชื่อ Picture 46 ตามด้านล่างดูครับ

Code: Select all

Sub delpic()
' Macro001 Macro
' แมโครถูกบันทึก ณ วันที่ 25/10/2011 โดย หมู ภูดินแดง
    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 = 0 Then
        MsgBox "ไม่มีรูปให้ลบ"
        Exit Sub
    End If
    If MsgBox("คุณต้องการลบตราโรงเรียน?", 36, "ยืนยันการลบ") = 6 Then
        ActiveSheet.Shapes("Picture 46").Select
        Selection.Delete
'         Cancel = True
    End If
End Sub
Sub ChPic()
' Macro001 Macro
' แมโครถูกบันทึก ณ วันที่ 25/10/2011 โดย หมู ภูดินแดง
    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
        Ans = MsgBox("มีรูปอยู่แล้วต้องการลบหรือไม่", vbYesNo)
    End If
    If Ans = vbYes Then
        ActiveSheet.Shapes("picture 46").Delete
    End If
    ActiveSheet.Pictures.Insert("C:\PP51\pic\pd.jpg").Name = "picture 46"
    ActiveSheet.Shapes("picture 46").Select
    Range("B1").Select
End Sub

[tigerwit]

ปรับแก้นิดหน่อย ได้แล้วครับ
ขอบพระคุณมากครับ

[tigerwit]

เรียนถามต่อว่า...
จากโค๊ดนี้

Sub ChPic()
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
Ans = MsgBox("มีรูปอยู่แล้วต้องการลบหรือไม่", vbYesNo)
End If
If Ans = vbYes Then
ActiveSheet.Shapes("picture 46").Delete
End If
ActiveSheet.Pictures.Insert("C:\PP51\pic\pd.jpg").Name = "picture 46"
ActiveSheet.Shapes("picture 46").Select
Range("B1").Select
End Sub

หากเราต้องการให้ผู้ใช้โปรแกรมสามารถเลือกไฟล์รูปภาพเป็นชื่ออื่น จากโฟลเดอร์ C:\PP51\pic เพื่อแทรกรูป แทนที่จะกำหนดให้ต้องเป็นชื่อ pd.jpg อย่างเดียว

จะต้องปรับโค๊ดอย่างไรครับ

[tigerwit]

พอดีไปเจอโค๊ดจากเว็บ http://www.mrexcel.com/archive/General/4711.html ซึ่งตรงกับความต้องการ
แต่มีปัญหานิดหน่อย...
จากไฟล์ที่แนบมา หลังจากแทรกรูปภาพแล้ว มันมีการสั่งให้ล็อค Sheet ผมพยายามดูแต่ละบรรทัดแล้ว ไม่รู้ว่าบรรทัดไหนสั่งให้ล็อค sheet
อาจารย์ช่วยดูหน่อยครับ

[snasui]

บรรทัดสำหรับการ Protect ตามด้านล่างครับ

Code: Select all

ActiveSheet.Protect True, True, True, True, True

[tigerwit]

ขอบคุณครับ..
อาจารย์ เราจะรู้ได้อย่างไรว่า รหัสปลดการป้อง sheet จากโค๊ดนี้คืออะไร ครับ

[snasui]

Password คือ TRUE ครับ

[tigerwit]

ผมเคยลองแล้ว แต่ไม่ผ่าน เพราะเป็นตัวเล็กทั้งหมด
เีรียนถามว่า ทำไมถึงเป็นตัวใหญ่ครับ ในเมื่อ
ActiveSheet.Protect True, True, True, True, True
มันก็เป็นตัวเล็ก
อาจารย์พออธิบายได้ไหมครับ

และขอนำแนะนำต่อเลยครับ
มีปัญหา ติดตรงที่เมื่อยกเลิกไม่แทรกรูปแล้ว sheet ไม่ lock ให้
รายละเอียดต่าง ๆ อยู่ในไฟล์ครับ

[snasui]

ผมเคยลองแล้ว แต่ไม่ผ่าน เพราะเป็นตัวเล็็็กทั้งหมด
เีรียนถามว่า ทำไมถึงเป็นตัวใหญ่ครับ ในเมื่อ
ActiveSheet.Protect True, True, True, True, True
มันก็เป็นตัวเล็ก
อาจารย์พออธิบายได้ไหมครับ

เนื่องจาก True และ False เป็น Keyword ของ โปรแกรม ดังนั้นการนำไปกำหนดค่า Password ในลักษณะตรงตัวเช่นนั้นจึงไม่สามารถทำได้ โปรแกรมจึงแปลงให้เป็น TRUE

สำหรับ Keyword ทั้งหมดดูได้จากที่นี่ครับ VBA Keyword

ส่วน Code ที่ถามมา ลองปรับเป็นตามด้านล่างครับ

Code: Select all

Sub InsPic2()
    'Code From..
    'http://www.snasui.com/viewtopic.php?f=3&t=1768
    'http://www.mrexcel.com/archive/General/4711.html
    'http://www.ozgrid.com/forum/showthread.php?t=24068
    
    Const strPath As String = "D:\" '<== Change to your path
    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
'        ChDrive strPath
        ChDir strPath
        ImgFileFormat = "Image Files (*.jpg),*.jpg"
        Imge = Application.GetOpenFilename(ImgFileFormat)
        If Imge <> "False" Then
            ActiveSheet.Unprotect Password = "1"
            ActiveSheet.Shapes("picture 46").Delete
            ActiveSheet.Pictures.Insert(Imge).Name = "picture 46"
            ActiveSheet.Protect Password = "1"
        End If
    End If
End Sub

[tigerwit]

Code: Select all

Sub InsPic2()
    'Code From..
    'http://www.snasui.com/viewtopic.php?f=3&t=1768
    'http://www.mrexcel.com/archive/General/4711.html
    'http://www.ozgrid.com/forum/showthread.php?t=24068
   
    Const strPath As String = "D:\" '<== Change to your path
    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
'        ChDrive strPath
        ChDir strPath
        ImgFileFormat = "Image Files (*.jpg),*.jpg"
        Imge = Application.GetOpenFilename(ImgFileFormat)
        If Imge <> "False" Then
            ActiveSheet.Unprotect Password = "1"
            ActiveSheet.Shapes("picture 46").Delete
            ActiveSheet.Pictures.Insert(Imge).Name = "picture 46"
            ActiveSheet.Protect Password = "1"
        End If
    End If
End Sub

จากโค๊ดนี้ครับ

ถ้าต้องการให้สามารถเลือกไฟล์รูปภาพอื่นเช่น bmp png tif
จะต้องแก้ไขโค๊ดอย่างไรครับ

[snasui]

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

Code: Select all

'...other code...
        ImgFileFormat = "Image Files (*.jpg*),*.jpg*"
        ImgFileFormat = ImgFileFormat & ",PNG Files (*.png*),*.png*"
        ImgFileFormat = ImgFileFormat & ",BMP Files (*.bmp*),*.bmp*"
'...other code...

[tigerwit]

สวัสดีครับ
ลองแก้ไขแล้วตามคำแนะนำ
ยังคงเห็นเฉพาะไฟล์ .jpg เท่านั้นครับ

[snasui]

ในเครื่องผมเห็นทั้งสามนามสกุลไฟล์ตามภาพครับ

[tigerwit]

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

pic.jpg (43.18 KiB) Viewed 55 times

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