Select all pictures
Manage your personal finances in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 5 of 5

Thread: Select all pictures

  1. #1
    Board Regular
    Join Date
    Mar 2002
    Location
    Sydney/Brisbane , Australia
    Posts
    538
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    How do i select all pictures in a worksheet and delete them using VBA.

  2. #2
    MrExcel MVP Anne Troy's Avatar
    Join Date
    Feb 2002
    Location
    Westwood NJ
    Posts
    2,581
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    ActiveSheet.DrawingObjects.Select
    Selection.Delete

    ~Anne Troy

  3. #3
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    This is a sample of some code I use to add a photo file to an Excel photo database. You may get started with some code of your own?
    Excel renames photo objects so the code is not too easy to work with! JSW

    Sub s_Photos()
    'Adds a photo below the last photo if any.

    Application.ScreenUpdating = False
    Range("D65536").End(xlUp).Offset(4, -2).Select
    ActiveCell.RowHeight = 118.5
    ActiveCell.ColumnWidth = 32.43

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThick
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThick
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThick
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThick
    .ColorIndex = xlAutomatic
    End With
    myFile = Application.InputBox("Enter your, ""Drive:PathFile.jpg"" for your Photo." _
    & Chr(13) & Chr(13) & " Like, C:MyFilesJSWExcelFOREST03.JPG" & Chr(13) & Chr(13) _
    & " In the box below!", Title:="Please indicate the photo location!" _
    , Default:="C:MyFilesJSWExcelFOREST03.JPG")
    On Error GoTo Kil
    'ActiveSheet.Pictures.Insert("C:MyFilesJSWExcelFOREST03.JPG").Select
    ActiveSheet.Pictures.Insert(myFile).Select
    Selection.ShapeRange.ScaleHeight 0.34, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.33, msoFalse, msoScaleFromTopLeft
    With Selection
    .Placement = xlMoveAndSize
    .PrintObject = True
    End With
    ActiveCell.Offset(0, 2).Select
    Selection.Interior.ColorIndex = xlNone
    With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlTop
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Photo: "
    With ActiveCell.Characters(Start:=1, Length:=8).Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
    Application.ScreenUpdating = True
    Kil:
    Range("A1").Select
    Application.ScreenUpdating = True

    End Sub



  4. #4
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-03-14 15:26, Dreamboat wrote:
    ActiveSheet.DrawingObjects.Select
    Selection.Delete

    Dreamboat....that code deletes all shapes
    I beleive he wants to delete only pictures
    If so then;

    Sub DeletePicts()
    Dim Pict As Object

    For Each Pict In ActiveSheet.Shapes
    If Pict.Type = 13 Then
    Pict.Delete
    End If
    Next
    End Sub

    Ivan

  5. #5
    Board Regular
    Join Date
    Mar 2002
    Location
    Sydney/Brisbane , Australia
    Posts
    538
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    thanks guys,
    i have used dreamboats code , and ivans update to it to get the result required.
    I have now got reports printing. woo hoo.
    never know. i might finish this program by july and have it operating around Australia.

    Thank you again.

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com