-1

VBAでアプリケーションを開発しています。ユーザーフォームは、SPSS Statistics SAV ファイルまたは SPSS Dimensions MDD ファイルを読み取る COM オブジェクトに接続します。

このアプリケーションの一部は XML ドキュメントにメタデータを保存するため、後でメタデータを取得して、ユーザーフォームから作成されたグラフィックを再入力または更新できます。ローカル ドライブに存在する XML ファイルに依存している限り、これはうまく機能しますが、これは望ましい解決策ではありません。XML を PPTM ファイルに埋め込む (リンクするのではなく) ことをお勧めします。

問題は、VBA で OLEObject XML ファイルを正常に抽出する方法が見つからないことです。

OLEObject は PPT から手動で開くことができ (mouseclick/etc)、正常にレンダリングされます。しかし、VBA がファイル パスを COM オブジェクトに渡すことができるように、プログラムでこのドキュメントを抽出してドライブに保存しようとすると、抽出された XML ファイルは常に破損しているように見えます。

私が見つけた唯一の方法は次のとおりです。

metaDoc.Copy
CreateObject("Shell.Application").Namespace(ActivePresentation.Path).self.InvokeVerb "Paste"

OLEFormat.ProgID = "Package" に問題があり、目的の動作ができない可能性があることを読みました。

PPTM ファイルの ZIP コピーを作成し、そのフォルダーから埋め込まれたドキュメント XML ファイルを抽出するなど、いくつかの回避策を念頭に置いていますが、これは機能するはずですが、この形状/オブジェクトをアクティブにして VBA 経由で操作するより簡単な方法があれば、それは非常に役に立ちます。

XML を作成して挿入するコードの例を次に示します。問題は、それをどのように抽出するか、または上記の ZIP メソッドを実行する必要があるかということです。

Public Const XMLFileName As String = "XML Embedded File.xml"
Sub ExampleCreateEmbedXML()

Dim fso As Object
Dim oFile As Object
Dim metaDoc As Shape
Dim shp As Shape
Dim sld As Slide
Dim user As String
Dim xmlExists As Boolean

xmlExists = False
user = Environ("Username")
XMLFilePath = "C:\Users\" & user & "\" & XMLFileName

Set sld = ActivePresentation.Slides(1)
For Each shp In sld.Shapes
    If shp.Name = XMLFileName Then
    xmlExists = True
    End If
Next

If Not xmlExists Then
'If the XML OLEObject doesn't exist, then create one:

'Create a new file in the active workbook's path
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile(XMLFilePath)
    oFile.Close

    'And then embed the new xml document into the appropriate slide
    Set metaDoc = sld.Shapes.AddOLEObject(FileName:=XMLFilePath _
            , Link:=False, DisplayAsIcon:=False)
    metaDoc.Name = XMLFileName

'Save this out to a drive so it can be accessed by a COM Object:
    metaDoc.Copy
    CreateObject("Shell.Application").Namespace(ActivePresentation.Path).self.InvokeVerb "Paste"

    'This file will be an empty XML file which will not parse, but even files that have been
    ' created correctly by the COM object (verified against the embed file vs. the extracted file)
    ' do not open properly. It seems that this method of pasting the object yields errors in
    ' xml structure.

    ' I have compared by activating the Metadoc object which renders fine in any XML viewer
    ' but the saved down version does not open and is obviously broken when viewed in txt editor

 Else:
    'The file exists, so at this point the COM object would read it
    ' and do stuff to the document or allow user to manipulate graphics through
    ' userform interfaces which connect to a database

    ' the COM object then saves the XML file

    ' another subroutine will then re-insert the XML File.
    ' this part is not a problem, it's getting VBA to open and read the OLEObject which is
    ' proving to be difficult.

 End If

 End Sub
4

1 に答える 1

1

多くの（LOT）検索の後、私はこれを書き留め、可能な解決策に出くわしたときに、いくつかの「プランB」ソリューションの1つに移っていました.

埋め込みパッケージ ファイル (.txt、.xml など) がアクティブ化されることはわかっていDoVerbs 1ますが、そこに含まれる XML を読み取る必要があるメモ帳の新しいインスタンスを制御できませんでした。

オブジェクトをコピーして貼り付けようとする代わりに (手動およびプログラムで失敗します)

    'Save this out to a drive so it can be accessed by a COM Object:
        metaDoc.Copy
    CreateObject("Shell.Application").Namespace(ActivePresentation.Path).self.InvokeVerb "Paste"

ここに投稿されたソリューションのわずかに変更されたバージョンを使用できました。

http://www.excelforum.com/excel-programming-vba-macros/729730-access-another-unsaved-excel-instance-and-unsaved-notepad-text.html

メモ帳の開いている保存されていないインスタンスを文字列として読み取り、それを新しいファイルに書き込みます。これはNotepadFunctions.ReadNotepad()、上記のリンクに記載されている関数から呼び出されます。

Sub ExtractLocalXMLFile(xlsFile As Object)
    'Extracts an embedded package object (TXT file, for example)
    ' reads string contents in from Notepad instance and
    ' prints a new file with string contents from embed file.
    
    Dim embedSlide As slide
    Dim DataObj As New MSForms.DataObject 'This is the container for clipboard contents/object
    Dim fullXMLString As String         'This is the captured string from clipboard.
    Dim t As Long                       'Timer variable
    
    MsgBox "Navigating to the hidden slide because objects can only be activated when " & _
            "the slide is active."
    
    Set embedSlide = ActivePresentation.Slides("Hidden")
    
    ActivePresentation.Windows(1).View.GotoSlide embedSlide.SlideIndex

    'Make sure no other copies of this exist in temp dir:
    
    On Error Resume Next
        Kill UserName & "\AppData\Local\Temp\" & _
             MetaDataXML_FilePath
                'replace an xls extension with txt
    On Error GoTo 0
    
    xlsFile.OLEFormat.DoVerb 1
            '1 opens XML package object -- ' for xls/xlsm files use Verb 2 to Open.
            ' in which case I can maybe control Notepad.exe
                                
    t = Timer + 1
    
    Do While Timer < t
        'Wait... while the file is opening
    Wend
    
    'Retrieve the contents of the embedded file
    
    fullXMLString = Notepad_Functions.ReadNotepad(Notepad_Functions.FindNotepad("Chart Meta XML"))
    
    'This function closes Notepad (would make it a subroutine, instead.
    
    'CloseAPP_B "NOTEPAD.EXE"  '<--- this function is NOT documented in my example on StackOverflow
    
    'Create a new text file
    
    WriteOutTextFile fullXMLString, MetaDataXML_FilePath
    
    'Get rid of the embedded file
    
    xlsFile.Delete
 
End Sub

Sub WriteOutTextFile(fileString As String, filePath As String)
    
    'Creates a txt file at filePath
    'inserting contents (filestring) from the temp package/XML object
    
    Dim oFile As Object
    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile(filePath)

    oFile.WriteLine (fileString)
    oFile.Close
    
End Sub
于 2013-02-11T16:24:51.957 に答える