• Trying to Insert,resize cell and photo using VBA

    Home » Forums » AskWoody support » Productivity software by function » MS Excel and spreadsheet help » Trying to Insert,resize cell and photo using VBA

    Author
    Topic
    #465755

    Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
    Example below
    .Height = Application.InchesToPoints(1.5)
    .Width = Application.InchesToPoints(1.75)
    Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
    Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
    Any possible suggestions

    Code:
    Dim sFile As Variant, r As Range
      Set r = Range("A1")
      
      sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
      If sFile = False Then Exit Sub
      ActiveSheet.Unprotect ""
      Dim i As Long
      For i = ActiveSheet.Pictures.Count To 1 Step -1
        If ActiveSheet.Pictures(i).Top = r.Top And _
            ActiveSheet.Pictures(i).Left = r.Left Then
          ActiveSheet.Pictures(i).Delete
        End If
      Next i
      With ActiveSheet.Pictures.Insert(sFile).ShapeRange
        .LockAspectRatio = True
        .Top = r.Top
        .Left = r.Left
        .Height = r.RowHeight * r.MergeArea.Rows.Count
      End With
      ActiveSheet.Protect ""
    
    Viewing 22 reply threads
    Author
    Replies
    • #1198872

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1199658

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1200501

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1201382

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1202195

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1202907

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1203873

      Iโ€™m using Excel 2007 and Iโ€™m trying to figure out if there is a way to insert a photo in a randomly selected cell and have both the photo and cell be re-sized the same using VBA
      Example below
      .Height = Application.InchesToPoints(1.5)
      .Width = Application.InchesToPoints(1.75)
      Currently Iโ€™m using code below to insert a photo into a pre sized cell, preselected cell.
      Using my present method takes up to much space if photos are not used, so what Iโ€™m trying to do is save open space on a sheet if areas are not used for photos
      Any possible suggestions

      Code:
      Dim sFile As Variant, r As Range
        Set r = Range("A1")
        
        sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
        If sFile = False Then Exit Sub
        ActiveSheet.Unprotect ""
        Dim i As Long
        For i = ActiveSheet.Pictures.Count To 1 Step -1
          If ActiveSheet.Pictures(i).Top = r.Top And _
              ActiveSheet.Pictures(i).Left = r.Left Then
            ActiveSheet.Pictures(i).Delete
          End If
        Next i
        With ActiveSheet.Pictures.Insert(sFile).ShapeRange
          .LockAspectRatio = True
          .Top = r.Top
          .Left = r.Left
          .Height = r.RowHeight * r.MergeArea.Rows.Count
        End With
        ActiveSheet.Protect ""
      
    • #1198259

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

      • #1198332

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1199233

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1199880

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1200636

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1201513

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1202326

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1203130

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

      • #1204028

        Hi stevehocking
        I thank you so much for this info, I well check it out, I am also somewhat “code challenged”. lol, getting better

    • #1199022

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1199763

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1200555

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1201436

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1202249

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1203053

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1203944

      Morning

      I was trying to do something similar in Excel 2003 and came across this article'Resize Image‘, I cannot claim to have done it with 100% accuracy because I am somewhat “code challenged”. Maybe you could adapt the suggestion to suit for Excel 2007

      Editted: Amend Typo

    • #1198409

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1199545

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1199971

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1200727

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1201646

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1202417

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1203296

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    • #1204131

      After reviewing the link you provided I was able to come up with a work around method that will serve my purpose. I first selected a row I wanted to insert photos in and then I set up width and height of selected cells to fit the size I needed for selected photos. Then by using a Check box (format control) using unchecked print and added a macro that will hide or unhide selected row using.

      Code:
         Dim Rng As Range
          Dim MyCell As Range
          Set Rng = Range("A1")
          For Each MyCell In Rng
              If MyCell.Value = "" Then
                  MyCell.EntireRow.Hidden = ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn
              End If
          Next MyCell
      

      I then inserted a command buttons, within selected cells in unhidden row, labeled โ€œinsert photo hereโ€ and set properties – PrintObject to False, then set Format Controls โ€“ properties to โ€œmove and size with cellโ€. This way if no photo is needed within this row I leave row hidden and command buttons. If I need a photo inserted within this row I unhide row and command buttons by using check box. Then I can select command button to insert photo. Iโ€™m using a code that adjusts photo size to selected cell. So far it seems to work OK. Hereโ€™s the code I use to insert and size photo.

      Code:
          Dim PicLocation As String
          Dim MyRange As String
          
          ActiveSheet.Range("A1").Select
          MyRange = Selection.Address
      
          PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
          
          If PicLocation  "False" Then
              ActiveSheet.Pictures.Insert(PicLocation).Select
          Else
              Exit Sub
          End If
          
          With Selection.ShapeRange
              .LockAspectRatio = msoTrue
              If .Width > .Height Then
                  .Width = Range(MyRange).Width
                  If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
              Else
                  .Height = Range(MyRange).Height
                  If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
              End If
          End With
          
          With Selection
              .Placement = xlMoveAndSize
              .PrintObject = True
          End With
          
          Range("A2").Select
      
    Viewing 22 reply threads
    Reply To: Reply #1198872 in Trying to Insert,resize cell and photo using VBA

    You can use BBCodes to format your content.
    Your account can't use all available BBCodes, they will be stripped before saving.

    Your information:




    Cancel