Re: get ole objects from powerpoint

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

I'd probably check each shape for the presence of a textframe and then
the presence of text and set a variable to the text string and change
teh text string incrementally in Word to add that string. But it would
be ugly since one would know the order to put it in Word doc, I don't
think.

Brian Reilly, MVP

On 6 Jan 2006 05:46:00 -0800, vonclausowitz@xxxxxxxxx wrote:

>This is what I have so far but it is not satisfactory.
>
>Sub TellAll()
>
>Dim arrShapes As Variant
>Dim iCount As Integer
>Dim objWord As Word.Application
>Dim objDoc As Word.Document
>ReDim arrShapes(0)
>
> Dim oSh As Shape
> For Each oSh In ActiveWindow.Selection.SlideRange(1).Shapes
> If oSh.Type = 7 Then
> arrShapes(iCount) = oSh.Name
> iCount = iCount + 1
> ReDim Preserve arrShapes(iCount)
> End If
> Next oSh
>
>For i = 0 To UBound(arrShapes) - 1
> ActiveWindow.Selection.SlideRange.Shapes(arrShapes(i)).Copy
>
> Set objWord = CreateObject("Word.application")
> objWord.Visible = True
>
> objWord.Documents.Add
> objWord.Selecti

on.Paste
> objWord.Dialogs(wdDialogFileSaveAs).Show
>
> objWord.Visible = True
>
>
> objWord.ActiveDocument.Close
> objWord.Visible = False
> objWord.Quit
>
> Set objWord = Nothing
>Next i
>
>End Sub
>
>because I use copy to get the content of the ole into word I miss
>things like header and footer.
>
>
>vonclausowitz@xxxxxxxxx schreef:
>
>> Hi All,
>>
>> I have a powerpoint slide with embedded some ole-objects (ie. word
>> files).
>> I want a VB code to extract all these worddocs and save them under a
>> certain name
>> in a certain folder.
>>
>> Anyone knows how to attchieve this?
>>
>> Regards
>>
>> Marco
>> The Netherlands
.

Relevant Pages

  • Re: Create array based on shape name or tag
    ... Dim oSh As Shape ... ReDim rayShapesAs String ... The extra monkey motion with the array is necessary because some versions of PPT ...
    (microsoft.public.powerpoint)
  • Search pattern
    ... Dim strfile As String ... Dim bAddressFound As Boolean ... Dim strCurrentChar As String ...
    (comp.databases.ms-access)
  • Auto Write Name and Merge across
    ... Dim Sheetname01 As String ... Dim WeekName01 As String ...
    (microsoft.public.excel.misc)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)