Can't get Worksheet.Cells().Paste to work

[enelson]

I may be completely lost here. I'm trying to copy / paste bulleted text from ppt textboxes to cells in excel. I'm trying to adapt some code I found earlier. This is what I have so far. It's getting hung up on the wks.Cells(slideNum, colNum).Paste. Thanks in advance. I also will need to associate images to these rows but I wanted to at least get the bulleted text right first.





Sub ExportTextToExcel()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSld As Slide
Dim oShp As Shape
Dim wkb As Workbook
Dim wks As Worksheet



Set oPres = ActivePresentation
Set oSlides = oPres.Slides

Set wkb = Workbooks.Open("C:\Users\Path_to_file.xlsm")
Set wks = wkb.Worksheets(1)
wks.Activate
slideNum = 0


For Each oSld In oSlides
slideNum = slideNum + 1
colNum = 0


For Each oShp In oSld.Shapes
colNum = colNum + 1

If oShp.HasTextFrame And oShp.TextFrame.HasText Then
If oShp.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered Then
oShp.TextFrame.TextRange.Copy
wks.Cells(slideNum, colNum).Paste

End If
End If
Next oShp
Next oSld
wkb.Close ([SaveChanges])
End Sub

[SamT]

A recommended change and a troubleshooting tip

For Each oShp In oSld.Shapes

If oShp.HasTextFrame And oShp.TextFrame.HasText Then
If oShp.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered Then
'Troubleshooting
MsgBox oShp.TextFrame.TextRange.Text 'Not good with PPT, Text may be wrong Property.

colNum = colNum + 1 '<----------- move here

'Commented out for Troubleshooting
'oShp.TextFrame.TextRange.Text.Copy 'Maybe
'wks.Cells(slideNum, colNum).Paste

'Also try
'wks.Cells(1, colNum) = SlideNum
'wks.Cells(2, colNum) = oShp.TextFrame.TextRange.Text

End If
End If
Next oShp

[John Wilson]

Have you set a reference to Excel?

(If you do not know what this means the answer is NO.)

[enelson]

Have you set a reference to Excel?

(If you do not know what this means the answer is NO.)

I think I have actually, if I go to Tool>References> , it shows a check next Microsoft Excel 16.0 Object Library. Is that what you mean? I've gotten the code below to move the text over but it obviously isn't keeping the bullet point format I was hoping to keep. My next challenge is figuring out how to associate and and move images with the text. So each slide has four text box and image combinations, they sit side by side so each image has an associated text box directly above it. What I'm hoping to be able to do is add another loop to this code such that when it finds a textbox with bullets, it moves that textbox then loops through each shape again and If type = image Then If left margin - textbox.leftmargin < 100 Then copy and move that image to the cell next to the text. I'm hoping that logic will work, getting the syntax right is the challenge. For me anyway. I need to take a VBA course.



Sub ExportTextToExcel()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSld As Slide
Dim oShp As Shape
Dim wkb As Workbook
Dim wks As Worksheet
Dim obj As dataObject

Set obj = New dataObject
Set oPres = ActivePresentation
Set oSlides = oPres.Slides
Set wkb = Workbooks.Open("C:\Path_to_workbook.xlsm")
Set wks = wkb.Worksheets(1)
slideNum = 0


For Each oSld In oSlides
slideNum = slideNum + 1
colNum = 0


For Each oShp In oSld.Shapes
If oShp.HasTextFrame And oShp.TextFrame.HasText Then
If oShp.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered Then
colNum = colNum + 1
oShp.TextFrame.TextRange.Copy
obj.GetFromClipboard
wks.Cells(slideNum, colNum).Value = obj.GetText
End If
End If
Next oShp
Next oSld
wkb.Save
wkb.Close


End Sub

[Paul_Hossler]

Something like this fragment -- Google 'CreateObject' for details





Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
Set wkb = xlApp.Workbooks.Open("C:\Path_to_workbook.xlsm")


You just set a Reference to the Excel object model (so Intellisense worked) but you didn't actually create an Excel instance that you could use in your macro

[enelson]

Something like this fragment -- Google 'CreateObject' for details





Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
Set wkb = xlApp.Workbooks.Open("C:\Path_to_workbook.xlsm")


You just set a Reference to the Excel object model (so Intellisense worked) but you didn't actually create an Excel instance that you could use in your macro

Hi Paul, I added this in and I'm getting an error at the line for wks.Cells(slideNum, colNum).Paste. Object doesn't support this property or method. This means I have to pastespecial? I'm trying to keep the bullet format somehow if possible.

[John Wilson]

You should declare the variables as PowerPoint or Excel

Dim oPres As Presentation
Dim oSlides As PowerPoint.Slides
Dim oSld As PowerPoint.Slide
Dim oShp As PowerPoint.Shape
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim obj As Excel.dataObject

[enelson]

Oh ok. So when I use .Copy to pull an image from powerpoint, I need to .Paste it to an excel variable?

[Paul_Hossler]

Something like this

No need to copy/paste




Option Explicit


Sub ExportTextToExcel()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSld As Slide
Dim oShp As Shape
Dim slideNum As Long, colNum As Long

Dim xlApp As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet

Set oPres = ActivePresentation
Set oSlides = oPres.Slides

Set xlApp = CreateObject("Excel.Application")
Set wkb = xlApp.Workbooks.Open("C:\Users\Daddy\Desktop\Book1.xlsx")
Set wks = wkb.Worksheets(1)

slideNum = 0


For Each oSld In oSlides
slideNum = slideNum + 1
colNum = 0


For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
If oShp.TextFrame.TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered Then
colNum = colNum + 1
wks.Cells(slideNum, colNum).Value = oShp.TextFrame.TextRange.Text
End If
End If
End If
Next oShp
Next oSld

wkb.Save
wkb.Close

xlApp.Quit



End Sub