Next without For error

[praveenlal]

Hi All,

I've written this code but getting Compile Error = Next without For error. Any expert help please

Sub Create_PPT()

Dim ppt_app As New PowerPoint.Application
Dim pre As PowerPoint.Presentation
Dim slde As PowerPoint.slide
Dim shp As PowerPoint.shape
Dim wb As Workbook
Dim rng As range

Dim vSheet$
Dim vRange$
Dim vWidth As Double
Dim vHeight As Double
Dim vTop As Double
Dim vLeft As Double
Dim vSlide_No As Long
Dim expRng As range

Dim adminSh As Worksheet
Dim configRng As range
Dim xlfile$
Dim pptfile$

Application.DisplayAlerts = False

Set adminSh = ThisWorkbook.Sheets("Data")
Set configRng = adminSh.range("rng_sheet")

xlfile = adminSh.[excelPth]
pptfile = adminSh.[pptPath]

Set wb = Workbooks.Open(xlfile)
Set pre = ppt_app.Presentations.Open(pptfile)

Set excelPth = adminSh.[excelPth]
Set pptPath = adminSh.[pptPath]

Set expRng = Sheets(vSheet$).range(vRange$)
Set slde = pre.Slides(vSlide_No)
Set shp = slde.Shapes(1)

wb.Activate

For Each rng In configRng

With ThisWorkbook.Sheets("Data")

wb.Sheets(rng.Value).Activate

With adminSh
vSheet$ = .Cells(rng.Row, 4).Value
vRange$ = .Cells(rng.Row, 5).Value
vWidth = .Cells(rng.Row, 6).Value
vHeight = .Cells(rng.Row, 7).Value
vTop = .Cells(rng.Row, 8).Value
vLeft = .Cells(rng.Row, 9).Value
vSlide_No = .Cells(rng.Row, 10).Value
End With

wb.Activate
Sheets(vSheet$).Activate
expRng.Copy

slde.Shapes.PasteSpecial ppPasteBitmap

With shp

.Top = vTop
.Left = vLeft
.Width = vWidth
.Height = vHeight

End With

Set shp = Nothing
Set slde = Nothing

Application.CutCopyMode = False

Next rng ''''GETTING ERROR ON THIS LINE''''

pre.Save

Set pre = Nothing
Set ppt_app = Nothing
Set expRng = Nothing
wb.Close False
Set wb = Nothing

Application.DisplayAlerts = True

End Sub

 

[MARK858]

Looks like you're missing an End With (in future can you please put your code in code tags as it makes it very difficult to read when you don't)

Sub Create_PPT()

    Dim ppt_app As New PowerPoint.Application
    Dim pre As PowerPoint.Presentation
    Dim slde As PowerPoint.slide
    Dim shp As PowerPoint.Shape
    Dim wb As Workbook
    Dim rng As Range

    Dim vSheet$
    Dim vRange$
    Dim vWidth As Double
    Dim vHeight As Double
    Dim vTop As Double
    Dim vLeft As Double
    Dim vSlide_No As Long
    Dim expRng As Range

    Dim adminSh As Worksheet
    Dim configRng As Range
    Dim xlfile$
    Dim pptfile$

    Application.DisplayAlerts = False

    Set adminSh = ThisWorkbook.Sheets("Data")
    Set configRng = adminSh.Range("rng_sheet")

    xlfile = adminSh.[excelPth]
    pptfile = adminSh.[pptPath]

    Set wb = Workbooks.Open(xlfile)
    Set pre = ppt_app.Presentations.Open(pptfile)

    Set excelPth = adminSh.[excelPth]
    Set pptPath = adminSh.[pptPath]

    Set expRng = Sheets(vSheet$).Range(vRange$)
    Set slde = pre.Slides(vSlide_No)
    Set shp = slde.Shapes(1)

    wb.Activate

    For Each rng In configRng

        With ThisWorkbook.Sheets("Data")

            wb.Sheets(rng.Value).Activate

            With adminSh
                vSheet$ = .Cells(rng.Row, 4).Value
                vRange$ = .Cells(rng.Row, 5).Value
                vWidth = .Cells(rng.Row, 6).Value
                vHeight = .Cells(rng.Row, 7).Value
                vTop = .Cells(rng.Row, 8).Value
                vLeft = .Cells(rng.Row, 9).Value
                vSlide_No = .Cells(rng.Row, 10).Value
            End With

            wb.Activate
            Sheets(vSheet$).Activate
            expRng.Copy

            slde.Shapes.PasteSpecial ppPasteBitmap

            With shp

                .Top = vTop
                .Left = vLeft
                .Width = vWidth
                .Height = vHeight

            End With

            Set shp = Nothing
            Set slde = Nothing

            Application.CutCopyMode = False
            
        End With

    Next rng                                     ''''GETTING ERROR ON THIS LINE''''

    pre.Save

    Set pre = Nothing
    Set ppt_app = Nothing
    Set expRng = Nothing
    wb.Close False
    Set wb = Nothing

    Application.DisplayAlerts = True

End Sub

 

[praveenlal]

Thanks Mark... but now getting Run-time Error 9 = Subscript out of Range

Set expRng = Sheets(vSheet$).range(vRange$)

Looks like you're missing an End With (in future can you please put your code in code tags as it makes it very difficult to read when you don't)

Sub Create_PPT()

    Dim ppt_app As New PowerPoint.Application
    Dim pre As PowerPoint.Presentation
    Dim slde As PowerPoint.slide
    Dim shp As PowerPoint.Shape
    Dim wb As Workbook
    Dim rng As Range

    Dim vSheet$
    Dim vRange$
    Dim vWidth As Double
    Dim vHeight As Double
    Dim vTop As Double
    Dim vLeft As Double
    Dim vSlide_No As Long
    Dim expRng As Range

    Dim adminSh As Worksheet
    Dim configRng As Range
    Dim xlfile$
    Dim pptfile$

    Application.DisplayAlerts = False

    Set adminSh = ThisWorkbook.Sheets("Data")
    Set configRng = adminSh.Range("rng_sheet")

    xlfile = adminSh.[excelPth]
    pptfile = adminSh.[pptPath]

    Set wb = Workbooks.Open(xlfile)
    Set pre = ppt_app.Presentations.Open(pptfile)

    Set excelPth = adminSh.[excelPth]
    Set pptPath = adminSh.[pptPath]

    Set expRng = Sheets(vSheet$).Range(vRange$)
    Set slde = pre.Slides(vSlide_No)
    Set shp = slde.Shapes(1)

    wb.Activate

    For Each rng In configRng

        With ThisWorkbook.Sheets("Data")

            wb.Sheets(rng.Value).Activate

            With adminSh
                vSheet$ = .Cells(rng.Row, 4).Value
                vRange$ = .Cells(rng.Row, 5).Value
                vWidth = .Cells(rng.Row, 6).Value
                vHeight = .Cells(rng.Row, 7).Value
                vTop = .Cells(rng.Row, 8).Value
                vLeft = .Cells(rng.Row, 9).Value
                vSlide_No = .Cells(rng.Row, 10).Value
            End With

            wb.Activate
            Sheets(vSheet$).Activate
            expRng.Copy

            slde.Shapes.PasteSpecial ppPasteBitmap

            With shp

                .Top = vTop
                .Left = vLeft
                .Width = vWidth
                .Height = vHeight

            End With

            Set shp = Nothing
            Set slde = Nothing

            Application.CutCopyMode = False
           
        End With

    Next rng                                     ''''GETTING ERROR ON THIS LINE''''

    pre.Save

    Set pre = Nothing
    Set ppt_app = Nothing
    Set expRng = Nothing
    wb.Close False
    Set wb = Nothing

    Application.DisplayAlerts = True

End Sub

 

[MARK858]

That means either your sheet name or range name in your variable is incorrect. Hover your mouse over the variables when it errors and check that they are correct and $ as far as I remember is an illegal character in a variable name

 

[GWteB]

@praveenlal , the Run-time error occurs since both vSheet and vRange are "empty", they don't carry a string value.
@MARK858, Dim vSheet$ equals Dim vSheet As String

 

[MARK858]

@MARK858, Dim vSheet$ equals Dim vSheet As String

I know that but he isn't just using it as part of a Dim statement, he is also using it as a variable name

vSheet$ = .Cells(rng.Row, 4).Value

 

[GWteB]

In this case the $ is just a suffix that most of us omit but which is recognized by the VBA compiler ....

Sub Suffix()
    Dim r As String
    r$ = 123
End Sub

 

[MARK858]

Point taken

 

[praveenlal]

Hi Mark, GWteb,

Still stuck on that error since yesterday. Declared vSheet and vRange in Locals, sheets names are correct, but still Unable to crack this error.

Can anyone of you help me with this.

Point taken

 

[praveenlal]

Wrote another VBA code to accomplish this task but now getting Object Variable or With Block Variable not Set. Can anyone help me with this error

Sub Create_PPT()

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim mySlideArray As Variant
Dim myRangeArray As Variant
Dim x As Long
Dim wb As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet

Set wb = ActiveWorkbook
Set sh1 = ThisWorkbook.Sheets("Close")
Set sh2 = ThisWorkbook.Sheets("Trend")
Set sh3 = ThisWorkbook.Sheets("Total_Cloud_Chart")
Set sh4 = ThisWorkbook.Sheets("AWS_Summary_Chart")
Set sh5 = ThisWorkbook.Sheets("Compute_Chart")
Set sh6 = ThisWorkbook.Sheets("Storage_Chart")


On Error Resume Next

Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear

If PowerPointApp Is Nothing Then
MsgBox "PowerPoint Presentation is not opened, aborting."
Exit Sub
End If

If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If

On Error GoTo 0

PowerPointApp.ActiveWindow.Panes(2).Activate

Set myPresentation = PowerPointApp.ActivePresentation

mySlideArray = Array(3, 4, 5, 6, 7, 8)

myRangeArray = Array(sh1.Range("A1:F14"), sh2.Range("A1:Q28"), _
sh3.Range("A1:P36"), sh4.Range("A1:AA26"), sh5.Range("A1:AA40"), sh6.Range("C1:AC28"))



For x = LBound(mySlideArray) To UBound(mySlideArray)

myRangeArray(x).Copy

On Error Resume Next

Set shp = PowerPoint.ActiveWindow.Selection.ShapeRange

On Error GoTo 0

With myPresentation.PageSetup

shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2) 'GETTING ERROR ON THIS LINE'
shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)

End With

Next x

Application.CutCopyMode = False

PowerPoint.Save

MsgBox "Report Completed"


End Sub