Macro Error: 438 Object doesn't support this property or method

[rob51852]

Hi All,

I am trying to develop a macro that will do a few things but am running into a problem with this line:

   ws.Shapes.Range(Array("Picture 1", "Picture 2", "Picture 3")). _
   Select
   Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse

Full code:

Option Explicit

Public Sub Process()

    Dim targetWorkbook As Workbook
    Dim summarySheet As Worksheet
    Dim sourceRange As Range
    Dim cell As Range

    ' Customize this settings
    Set targetWorkbook = Workbooks("Book1.xlsx")
    Set summarySheet = ThisWorkbook.Worksheets("Summary")
    Set sourceRange = summarySheet.Range("Q3:Q5")

    Application.ScreenUpdating = False
    
    ' Loop through each cell in source range
    For Each cell In sourceRange.Cells
        ' Validate that cell has a value
        If cell.Value <> vbNullString Then
        
            summarySheet.Range("F3").Value = cell.Value
            ' Execute procedure to create new sheet
            
            DoEvents
            
            CreateNewSheet
        End If
    Next cell

    Application.ScreenUpdating = True
End Sub

Sub CreateNewSheet()
   Dim ws As Worksheet
   Application.ScreenUpdating = False
   Application.Calculation = xlManual
   Set ws = Workbooks("Book1.xlsx").Worksheets.Add(After:=Workbooks("Book1.xlsx").Worksheets(Workbooks("Book1.xlsx").Worksheets.Count))
   ws.Name = ThisWorkbook.Worksheets("Summary").Range("E3").Value
    
   With ThisWorkbook.Worksheets("Summary").Range("A71:N221").Copy
      ws.Range("A42").PasteSpecial Paste:=xlPasteValues
      ws.Range("A42").PasteSpecial Paste:=xlPasteFormats
      ws.Range("A42").PasteSpecial Paste:=xlPasteColumnWidths
      ws.Range("A:N").Font.Size = 10
   End With

   With ThisWorkbook.Worksheets("Summary").ChartObjects("OvAve").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("A1").PasteSpecial
   End With
   
   With ThisWorkbook.Worksheets("Summary").ChartObjects("OvSR").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("E1").PasteSpecial
   End With
   
   With ThisWorkbook.Worksheets("Summary").ChartObjects("OvBP").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("J1").PasteSpecial
   End With
   
   With ThisWorkbook.Worksheets("Summary").ChartObjects("PSAve").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("A13").PasteSpecial
   End With
   
   With ThisWorkbook.Worksheets("Summary").ChartObjects("PSSR").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("H13").PasteSpecial
   End With
   
   With ThisWorkbook.Worksheets("Summary").ChartObjects("IVBA").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("A27").PasteSpecial
   End With
   
   With ThisWorkbook.Worksheets("Summary").ChartObjects("IVSR").Chart.CopyPicture(Appearance:=xlScreen, Format:=xlPicture)
   ws.Range("H27").PasteSpecial
   End With
   
   ws.Shapes.Range(Array("Picture 1", "Picture 2", "Picture 3")). _
   Select
   Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse

   Application.Calculation = xlAutomatic
   Application.ScreenUpdating = True
End Sub

The macro copies charts as images and pastes them into Book1. That works ok but when I then try to rearrange some of them I get the 438 error.

Can anyone see what the issue is?

Thanks

 

[RoryA]

One possible cause would be that sheet not being active. Instead of selecting the shapes, manipulate them directly:

ws.Shapes.Range(Array("Picture 1", "Picture 2", "Picture 3")).Distribute msoDistributeHorizontally, msoFalse

 

[rob51852]

That seems to have done the trick. Thanks Rory