VBA code to align a picture to the RIGHT

[shophoney]

Hi,

Below is my VBA code to grab a jpg picture from the web. Currently it inserts it CENTRED, how can I justify it to the RIGHT?

Sub URLPictureInsert()
Call delete_picture

Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set rng = ActiveSheet.Range("R6:R30")
For Each cell In rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column - 17
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
.Width = 15
.Height = 15
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("R6").Select
Next
Application.ScreenUpdating = True
End Sub
Public Sub delete_picture()
For Each shp In ActiveSheet.Shapes
If Not Intersect(shp.TopLeftCell, [A6:A30]) Is Nothing Then shp.Delete
Next
End Sub

 

[GWteB]

Try replacing this line

.Left = xRg.Left + (xRg.Width - .Width) / 2

with this line

.Left = xRg.Left + xRg.Width - .Width

 

[DanteAmor]

I made some changes to your code. You should not use the On Error Resume Next statement, because if an error occurs, you will not know what the error is, or in which line of code.
It is also not good practice to use the GoTo statement.

Try this:

Sub URLPictureInsert()
  Dim Pshp As Shape
  Dim xRg As Range, rng As Range, cell As Range
  Dim xCol As Long
  
  Application.ScreenUpdating = False
  
  Call delete_picture
  Set rng = ActiveSheet.Range("R6:R30")
  For Each cell In rng
    If cell.Value <> "" Then
      If Dir(cell.Value) <> "" Then
        ActiveSheet.Pictures.Insert(cell.Value).Select
        Set Pshp = Selection.ShapeRange.Item(1)
        If Not Pshp Is Nothing Then
          xCol = cell.Column - 17
          Set xRg = Cells(cell.Row, xCol)
          With Pshp
            .LockAspectRatio = msoFalse
            .Width = 15
            .Height = 15
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width)
          End With
        End If
        Set Pshp = Nothing
      End If
    End If
  Next
  Range("R6").Select
  Application.ScreenUpdating = True
End Sub