Snasui Excel Forum

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

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

Code: Select all

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

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

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

Code: Select all

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