Office 365 update has killed my photos array macro - help!

melodramatic

melodramatic

Board Regular
Joined
Apr 28, 2003
Messages
180
Office Version
  1. 365
Platform
  1. Windows
I have a macro that will go thru a folder for our tests, pull all the photos and line them up in order. Everything has worked fine for several years.

Then I did my office365 update Friday. The code died with it.

When I run the macro, I get a Run-time error '1004': The item with the specified name wasn't found.

The error appears at the 2nd line after the 2-line break (I've got it marked to the right) in my coding, as shown below:

Code: 
For ListRow = 5 To LastRow
    Sheets("jpgList").Select
    If Range("C" & ListRow) = "Y" Then
        PhotoFile = PhotosFolder & "\" & Range("B" & ListRow)
        PhotoOrient = Range("D" & ListRow)
        Sheets("PhotoArray").Select
        If PhotoOrient = "Landscape" Then
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 342
            Range("A" & ArrayRow).Select
                  
                ActiveSheet.Pictures.Insert(PhotoFile).Select
                ActiveSheet.Shapes.Range(Array("Picture " & PhotoNum)).Select                      '<<------ THIS IS WHERE MY ERROR POPS UP
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.ShapeRange.IncrementRotation 0
                    Selection.ShapeRange.LockAspectRatio = msoFalse
                    Selection.ShapeRange.Height = 340
                    Selection.ShapeRange.Width = 456
                    Selection.ShapeRange.IncrementTop 1.5
        End If
      
        If PhotoOrient = "Portrait" Then
            Rows(ArrayRow & ":" & ArrayRow).Select
            If ArrayRow > 2 Then
                ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
            End If
                Selection.RowHeight = 130
            ArrayRow = ArrayRow + 1
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 342
            Range("A" & ArrayRow).Select
                ActiveSheet.Pictures.Insert(PhotoFile).Select
            ArrayRow = ArrayRow + 1
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 130
                ActiveSheet.Shapes.Range(Array("Picture " & PhotoNum)).Select
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.ShapeRange.LockAspectRatio = msoFalse
                    Selection.ShapeRange.Height = 340
                    Selection.ShapeRange.Width = 456
                    Selection.ShapeRange.IncrementRotation 90
                    Selection.ShapeRange.IncrementTop 70
        End If
      
        ArrayRow = ArrayRow + 1
        Rows(ArrayRow & ":" & ArrayRow).Select
            Selection.RowHeight = 28.5
        Range("B" & ArrayRow).Select
            ActiveCell.Value = PhotoNum
        Range("A" & ArrayRow).Select
            ActiveCell.Formula = "=VLOOKUP(B" & ArrayRow & ",Table1,6,FALSE)"
        ArrayRow = ArrayRow + 1
        PhotoNum = PhotoNum + 1

    End If
      
Next ListRow
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Your actual error is likely on this line...
Code: 
ActiveSheet.Pictures.Insert(PhotoFile).Select
which likely means this line of code is wrong....
Code: 
PhotoFile = PhotosFolder & "\" & Range("B" & ListRow)
You haven't identified what PhotosFolder is an/or what lastrow is (I assume it's earlier in the code not shown). Also, you have used selection everywhere which is not necessary. You also need to be specific with what sheet your referring to... Activesheet is OK but not desireable. For example this code should at least be...
Code: 
PhotoFile = PhotosFolder & "\" & Activesheet.Range("B" & ListRow)
I'm guessing if U remove all the unnecessary selections and specify what sheet rows and ranges you are referring to then your code will again work. HTH. Dave
 
Upvote 0
The line that's highlighted when the error occurs is the one that I pointed out. I know that the line you suggested is wrong is correct, because that action has been completed before the error comes (meaning the photo has already been inserted on the sheet - it's locking up on trying to size the photo).

Capture.JPG


I can go in and add the "ActiveSheet" in a bit - but right now I just want to get past this one error line.

My entire code is below - wondering if that will help...

VBA Code: 
Sub PhotoArray()
'PhotoArray Written by Melody October May
'Originally Launched 2017-05-23

Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Dim PhotosFolder As String 'Entire folder structure for photos
Dim PhotoCount As Long '# of Photos marked "Include"
Dim PhotoNum As Long 'Photo # in sequence
Dim ListRow As Long 'Row # on jpgList
Dim ArrayRow As Long 'Row # on PhotoArray sheet
Dim PhotoFile As String 'Photo filename from jpgList
Dim PhotoOrient As String 'Landscape or Portrait from jpgList
Dim PhotoWidth As Long 'width of photo being put into PhotoArray
Dim PhotoHeight As Long 'height of photo being put into PhotoArray
Dim RowHeight As Long 'height of current ArrayRow
Dim RowExpanse As Long 'added row for portrait photo on PhotoArray

Sheets("jpgList").Select
PhotoCount = Range("B1")
PhotoNum = 1
ListRow = 5
ArrayRow = 1
LastRow = Range("A1")
PhotosFolder = Range("E2")


Sheets("Input").Select
    FooterLeft = Range("F10")
    FooterRight = Range("F11")

Call SetArraySheet

For ListRow = 5 To LastRow

    Sheets("jpgList").Select
    
    If Range("C" & ListRow) = "Y" Then
        
        PhotoFile = PhotosFolder & "\" & Range("B" & ListRow)
        PhotoOrient = Range("D" & ListRow)
                
        Sheets("PhotoArray").Select

        If PhotoOrient = "Landscape" Then
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 342
            Range("A" & ArrayRow).Select
                    
                ActiveSheet.Pictures.Insert(PhotoFile).Select
                ActiveSheet.Shapes.Range(Array("Picture " & PhotoNum)).Select   <<-- THIS IS THE LINE THAT IS HIGHLIGHTED AT THE ERROR
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.ShapeRange.IncrementRotation 0
                    Selection.ShapeRange.LockAspectRatio = msoFalse
                    Selection.ShapeRange.Height = 340
                    Selection.ShapeRange.Width = 456
                    Selection.ShapeRange.IncrementTop 1.5
        End If
        
        If PhotoOrient = "Portrait" Then
            Rows(ArrayRow & ":" & ArrayRow).Select
            If ArrayRow > 2 Then
                ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
            End If
                Selection.RowHeight = 130
            ArrayRow = ArrayRow + 1
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 342
            Range("A" & ArrayRow).Select
                ActiveSheet.Pictures.Insert(PhotoFile).Select
            ArrayRow = ArrayRow + 1
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 130
                ActiveSheet.Shapes.Range(Array("Picture " & PhotoNum)).Select
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.ShapeRange.LockAspectRatio = msoFalse
                    Selection.ShapeRange.Height = 340
                    Selection.ShapeRange.Width = 456
                    Selection.ShapeRange.IncrementRotation 90
                    Selection.ShapeRange.IncrementTop 70
        End If
        
        ArrayRow = ArrayRow + 1
        Rows(ArrayRow & ":" & ArrayRow).Select
            Selection.RowHeight = 28.5
        Range("B" & ArrayRow).Select
            ActiveCell.Value = PhotoNum
        Range("A" & ArrayRow).Select
            ActiveCell.Formula = "=VLOOKUP(B" & ArrayRow & ",Table1,6,FALSE)"
        ArrayRow = ArrayRow + 1
        PhotoNum = PhotoNum + 1
            
    End If
        
Next ListRow
        
Range("A1").Select
Sheets("jpgList").Select
ActiveSheet.Protect
Sheets("PhotoArray").Select
ActiveSheet.Protect
Range("A1").Select

Sheets("Input").Select
pdffilename = Range("F9")
Sheets("PhotoArray").Select

    ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=PhotosFolder & "\" & pdffilename, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

ActiveWorkbook.Save

MsgBox ("Photo run is complete, and " & PhotoNum - 1 & " photos have been sent to a PDF file." & vbNewLine & vbNewLine & _
        "To make changes, go to the jpgList sheet."), vbOKOnly
        
End Sub



Sub SetArraySheet()
'SetArraySheet Written by Melody October May
'Originally Launched 2017-05-23

Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Dim FooterLeft As String
Dim FooterRight As String
Dim FooterLine As String
Dim ProjLoc As String
Dim ws As Worksheet

    For Each ws In Worksheets
        If ws.Name = "PhotoArray" Then
            Sheets("PhotoArray").Delete
        End If
    Next

    Sheets("Input").Select
    ProjLoc = Left(Range("J21"), 1)
    FooterLine = String(102, "_")
    FooterLeft = FooterLine & vbLf & Range("F10")
    FooterRight = Range("F11")

    If ProjLoc = "N" Then
        Sheets("Array-A4").Visible = True
            Sheets("Array-A4").Copy After:=Sheets(3)
            Sheets("Array-A4 (2)").Select
            Sheets("Array-A4 (2)").Name = "PhotoArray"
        Sheets("Array-A4").Visible = False
    Else
        Sheets("Array-LTR").Visible = True
            Sheets("Array-LTR").Copy After:=Sheets(3)
            Sheets("Array-LTR (2)").Select
            Sheets("Array-LTR (2)").Name = "PhotoArray"
        Sheets("Array-LTR").Visible = False
    End If

    Sheets("PhotoArray").Select
    With ActiveSheet.PageSetup
    
        .LeftFooter = "&8" & FooterLeft
        .RightFooter = "&8" & FooterRight
        
    End With
    
ActiveWorkbook.Save

End Sub
 
Upvote 0
OK, got it fixed. The line that's giving me an error, I commented out, and the macro runs. I guess that with me having just inserted the photo the line before, that photo was selected and picked up the sizing without having to focus on it.

Thanks to all that took a look for me!
 
Upvote 0
Just delete that line & landscape will be fine. for portrait make these changes
VBA Code: 
            Range("A" & ArrayRow).Select
               
            ArrayRow = ArrayRow + 1
            Rows(ArrayRow & ":" & ArrayRow).Select
                Selection.RowHeight = 130
               
              ActiveSheet.Pictures.Insert(PhotoFile).Select
                    Selection.ShapeRange.Line.Visible = msoFalse
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

melodramatic
  • Question
Vba - insert photo with varying sizes
Replies
1
Views
255
Micron
M
O
  • Solved
Determine picture height in VBA
2
Replies
11
Views
2K
jolivanes
jolivanes
melodramatic
  • Question
Using VBA to set size and placement of picture
Replies
2
Views
11K
melodramatic
melodramatic

Forum statistics

Threads
1,214,625
Messages
6,120,598
Members
448,973
Latest member
ksonnia

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top