Centering image (horizontally) in Range

Hello,

Excuse me if I'm asking a simple question, but I'm a bit of a noob when it comes to VBA. As a matter of fact I live on Copy and Paste and sometimes I actually understand what I've copied and I'm able to adjust it to my needs. In this manner I have made an excel file that imports pictures from my harddisk into a named Range. I have tried many other sites for an answer. I have however not been able to center the images horizontally (width of different images varies) in that Range.

I would be very gratefull if someone could help me with this.

Below is the code I have copied and adjusted:

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
    If Target.Address = ("$B$3") Then
    Range("B4") = ""
    Range("B5") = ""
    Range("B6") = ""
    End If
    
    If Target.Address = ("$B$4") Then
    Range("B5") = ""
    Range("B6") = ""
    End If
    
    If Target.Address = ("$B$5") Then
    Range("B6") = ""
    End If
    
    If Not Intersect(Target, Range("rngDisplayName1")) Is Nothing Then
         InsertPicFromFile1 _
            strFileLoc:=Range("rngFileLocation1").Value, _
            rDestCells1:=Range("rngPicDisplayCells1"), _
            blnFitInDestHeight:=True, _
            strPicName:="MyDVPic1"
    End If
    
    If Not Intersect(Target, Range("rngDisplayName2")) Is Nothing Then
         InsertPicFromFile2 _
            strFileLoc:=Range("rngFileLocation2").Value, _
            rDestCells2:=Range("rngPicDisplayCells2"), _
            blnFitInDestHeight:=True, _
            strPicName:="MyDVPic2"
    End If
    
    If Not Intersect(Target, Range("rngDisplayName3")) Is Nothing Then
         InsertPicFromFile3 _
            strFileLoc:=Range("rngFileLocation3").Value, _
            rDestCells3:=Range("rngPicDisplayCells3"), _
            blnFitInDestHeight:=True, _
            strPicName:="MyDVPic3"
    End If
   Application.ScreenUpdating = True
End Sub




Sub InsertPicFromFile1( _
   strFileLoc As String, _
   rDestCells1 As Range, _
   blnFitInDestHeight As Boolean, _
   strPicName As String)

   Dim oNewPic As Shape
   Dim shtWS As Worksheet

   Set shtWS = rDestCells1.Parent

   On Error Resume Next
   'Delete the named picture (if it already exists)
   shtWS.Shapes(strPicName).Delete
   
   On Error Resume Next
   With rDestCells1
      'Create the new picture
      '(arbitrarily sized as a square that is the height of the rDestCells)
      Set oNewPic = shtWS.Shapes.AddPicture( _
         Filename:=strFileLoc, _
         LinkToFile:=msoFalse, _
         SaveWithDocument:=msoTrue, _
         Left:=.Left + 1, Top:=.Top + 1, Width:=.Height - 1, Height:=.Height - 1)
      
      'Maintain original aspect ratio and set to full size
      oNewPic.LockAspectRatio = msoTrue
      oNewPic.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
      oNewPic.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
      
      If blnFitInDestHeight = True Then
         'Resize the picture to fit in the destination cells
         oNewPic.Height = .Height - 1
      End If
      
      'Assign the desired name to the picture
      oNewPic.Name = strPicName
   End With 'rCellDest
End Sub

Sub InsertPicFromFile2( _
   strFileLoc As String, _
   rDestCells2 As Range, _
   blnFitInDestHeight As Boolean, _
   strPicName As String)

   Dim oNewPic As Shape
   Dim shtWS As Worksheet

   Set shtWS = rDestCells2.Parent

   On Error Resume Next
   'Delete the named picture (if it already exists)
   shtWS.Shapes(strPicName).Delete
   
   On Error Resume Next
   With rDestCells2
      'Create the new picture
      '(arbitrarily sized as a square that is the height of the rDestCells)
      Set oNewPic = shtWS.Shapes.AddPicture( _
         Filename:=strFileLoc, _
         LinkToFile:=msoFalse, _
         SaveWithDocument:=msoTrue, _
         Left:=.Left + 1, Top:=.Top + 1, Width:=.Height - 1, Height:=.Height - 1)
      
      'Maintain original aspect ratio and set to full size
      oNewPic.LockAspectRatio = msoTrue
      oNewPic.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
      oNewPic.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
      
      If blnFitInDestHeight = True Then
         'Resize the picture to fit in the destination cells
         oNewPic.Height = .Height - 1
      End If
      
      'Assign the desired name to the picture
      oNewPic.Name = strPicName
   End With 'rCellDest
End Sub


Sub InsertPicFromFile3( _
   strFileLoc As String, _
   rDestCells3 As Range, _
   blnFitInDestHeight As Boolean, _
   strPicName As String)

   Dim oNewPic As Shape
   Dim shtWS As Worksheet

   Set shtWS = rDestCells3.Parent

   On Error Resume Next
   'Delete the named picture (if it already exists)
   shtWS.Shapes(strPicName).Delete
   
   On Error Resume Next
   With rDestCells3
      'Create the new picture
      '(arbitrarily sized as a square that is the height of the rDestCells)
      Set oNewPic = shtWS.Shapes.AddPicture( _
         Filename:=strFileLoc, _
         LinkToFile:=msoFalse, _
         SaveWithDocument:=msoTrue, _
         Left:=.Left + 1, Top:=.Top + 1, Width:=.Height - 1, Height:=.Height - 1)
      
      'Maintain original aspect ratio and set to full size
      oNewPic.LockAspectRatio = msoTrue
      oNewPic.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
      oNewPic.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
      
      If blnFitInDestHeight = True Then
         'Resize the picture to fit in the destination cells
         oNewPic.Height = .Height - 1
      End If
      
      'Assign the desired name to the picture
      oNewPic.Name = strPicName
   End With 'rCellDest
End Sub

Thanks in advance...