Hi guys , i need help on my project , as i have an macro working in opening a ppt slides and how much cells are needed to present on the ppt , but however there is a problem , the values are not showing up , only the blank cells.
Please help me , all help is deeply and truly appreciate , i am only an beginner with macro-ing.
below are my codes:
[VBA]Sub ExcelToPPT_Table()
Range("D4").Select
ActiveCell.FormulaR1C1 = "=INDEX(R[-2]C[-3]:R[20]C[-3],RANDBETWEEN(2,24))"
Range("D4").Select
Calculate
Range("D6").Select
Selection.Copy
'Find the last used row in a Column: column F in this example
Dim LastRow As Long
Dim rngData As Range
Dim appPPT As PowerPoint.Application
Dim prsTest As PowerPoint.Presentation
Dim sldTest As PowerPoint.Slide
Dim shpTest As Table
Dim rngCell As Range
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
With ActiveSheet
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
Cells(LastRow + 1, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rngData = Range("C46")
Set appPPT = CreateObject("Powerpoint.application")
appPPT.Visible = True
Set prsTest = appPPT.Presentations.Add
appPPT.ActiveWindow.ViewType = ppViewSlide
Set sldTest = prsTest.Slides.Add(1, ppLayoutBlank)
sldTest.Shapes.AddTable rngData.Rows.Count, rngData.Columns.Count
Set shpTest = sldTest.Shapes(sldTest.Shapes.Count).Table
For Each rngCell In rngData
Set appPPT = GetObject(, "PowerPoint.Application")
Next
End With
End Sub[/VBA]
Reply With Quote
