Insert and Center Image

[kscafi]

Hello all,

I am new to coding VBA and I am stuck on two aspects of the code. I am trying to insert an image under data that is on the excel sheet(the image is coming from a file on my computer), automatically delete the previous image without deleting a logo that is on the worksheet, and center the image horizontally. Inserting and placing the image under the data on the table works perfectly and sizes perfectly, but I am struggling to center the image horizontally on the page and delete the image. I have tried multiple methods for both, but I have not been successful. I can't seem to delete the image without deleting the logo. Below is my code.

Thank you for reading. Any help is much appreciated



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)


Dim myPict As Picture
Dim PictureLoc As String
Dim last_row As Long
Dim Copyrange As String
Dim targetCell As Range
Dim HELP As String




Set targetCell = ActiveSheet.Range("A35")
last_row = Cells(Rows.Count, 1).End(xlUp).Row + 2
Copyrange = "B" & last_row & ":" & "B35"






HELP = ((targetCell.MergeArea.Width - myPict.Width) / 2)


If Target.Address = Range("B6").Address Then
'ActiveSheet.Pictures.Delete
PictureLoc = Range("O8").Value & "INSERT PATH HERE" & Range("B6").Value & ".PNG"
Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)

With myPict
'Resize picture to fit in the range....
.ShapeRange.LockAspectRatio = msoTrue
.Left = (targetCell.Left + "HELP")
'ActiveSheet.Cells(last_row, "A").Left

.Top = ActiveSheet.Cells(last_row, "B").Top
.Height = ActiveSheet.Range(Copyrange).Height
'.Width = ActiveSheet.Range("B18:J15").Width
'.Placement = 1
'.PrintObject = True
End With
End If


MsgBox (myPict.Width)
MsgBox (targetCell.MergeArea.Width)
MsgBox (targetCell.Left)
MsgBox (HELP)


End Sub

 

[DanteAmor]

I did not understand where or in what range of cells you want to center the image.


But the following will help the previously inserted image.

Try and tell me.

Note: Before executing the first time, delete the image you have inserted. Then in automatic they will be deleted.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myPict As Picture, PictureLoc As String, last_row As Long
  Dim Copyrange As String, targetCell As Range, HELP As String
  
  Set targetCell = ActiveSheet.Range("A35")
  last_row = Cells(Rows.Count, 1).End(xlUp).Row + 2
  Copyrange = "B" & last_row & ":" & "B35"
  If Target.Address = Range("B6").Address Then
    'ActiveSheet.Pictures.Delete
[COLOR=#ff0000]    On Error Resume Next[/COLOR]
[COLOR=#ff0000]    ActiveSheet.Pictures("imgtmp").Delete[/COLOR]
[COLOR=#ff0000]    On Error GoTo 0[/COLOR]


    PictureLoc = Range("O8").Value & "INSERT PATH HERE" & Range("B6").Value & ".PNG"
    Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
    With myPict
      'Resize picture to fit in the range....
[COLOR=#0000ff]      HELP = ((targetCell.MergeArea.Width - .Width) / 2)    '[/COLOR][COLOR=#ff0000]This line must go within With[/COLOR]
      .ShapeRange.LockAspectRatio = msoTrue
      .Left = (targetCell.Left + "HELP")
      .Top = ActiveSheet.Cells(last_row, "B").Top
      .Height = ActiveSheet.Range(Copyrange).Height
[COLOR=#ff0000]      .Name = "imgtmp"[/COLOR]
    End With
  End If
End Sub

 

[kscafi]

It deletes the picture just as I was hoping, thank you so much.

To further explain myself on centering the image. I would like to center the image between on the print page which spans from column A to K with the top of the image located on the row after the one with information/data in it. I read online that if I created a merged cell from columns A - K I could insert it there, I was unsuccessful. I merged A23:K23 and I still could not get it to center. The main goal is to get the image to center itself on the print page so that when the picture is inserted so we do not have to move it to center.

Please let me know if you need more information. Thank you.

 

[DanteAmor]

It deletes the picture just as I was hoping, thank you so much.

To further explain myself on centering the image. I would like to center the image between on the print page which spans from column A to K

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myPict As Picture, PictureLoc As String, Copyrange As String
  If Target.Address = Range("B6").Address Then
    On Error Resume Next
    ActiveSheet.Pictures("imgtmp").Delete   [COLOR=#008000]'Pictures Delete[/COLOR]
    On Error GoTo 0
    Copyrange = "B" & Cells(Rows.Count, 1).End(xlUp).Row + 2 & ":" & "[B][COLOR=#ff0000]L35[/COLOR][/B]"
    PictureLoc = Range("O8").Value & "INSERT PATH HERE" & Range("B6").Value & ".PNG"
    Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
    With myPict [COLOR=#008000]'Resize picture to fit in the range....[/COLOR]
      .ShapeRange.LockAspectRatio = msoFalse
      .Top = Range(Copyrange).Top
      .Height = Range(Copyrange).Height
[COLOR=#0000ff]      .Left = (Range(Copyrange).Width - myPict.Width) / 2[/COLOR]
      .Name = "imgtmp"
    End With
  End If
End Sub

 

[kscafi]

Works perfect! Thank you!

 

[DanteAmor]

Works perfect! Thank you!

I'm glad to help you. Thanks for the feedback.