Next without For error

P

praveenlal

New Member
Joined
Oct 27, 2021
Messages
34
Office Version
  1. 2016
Platform
  1. Windows
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
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
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)

Rich (BB code): 
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
 
Upvote 0
Thanks Mark... but now getting Run-time Error 9 = Subscript out of Range

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

MARK858 said:
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)

Rich (BB code): 
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
Click to expand...
 
Upvote 0
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
 
Upvote 0
@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
 
Upvote 0
GWteB said:
@MARK858, Dim vSheet$ equals Dim vSheet As String
Click to expand...
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
VBA Code: 
vSheet$ = .Cells(rng.Row, 4).Value
 
Upvote 0
In this case the $ is just a suffix that most of us omit but which is recognized by the VBA compiler ....
VBA Code: 
Sub Suffix()
    Dim r As String
    r$ = 123
End Sub
 
Upvote 0
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.
MARK858 said:
Point taken ;)
Click to expand...
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Excel to PPT Export VBA Error
Replies
7
Views
921
rlv01
R
B
  • Question
Excel to Powerpoint VBA for Auto Slidedecks
Replies
1
Views
1K
Mehe
M
M
  • Question
How to get a shape by its name through a variable
Replies
1
Views
3K
Domenic
D
mariana_akai
  • Question
Issue with copy/paste tables/shapes from Excel to PowerPoinnt
Replies
1
Views
1K
Mehe
M

Forum statistics

Threads
1,215,152
Messages
6,123,323
Members
449,094
Latest member
Chestertim

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