使用VBA将图像从MindManagerMap提取到Word

时间:2019-04-23 11:08:04

标签: vba ms-word

我必须使用VBA从思维导图中提取图像,并将其放入Word文档中,而不是随机生成,它必须与思维图相同。不幸的是,由于公司原因,我无法提供MindMap。

这是我第一次成功获取图像。提取和粘贴文本很简单,“ ExportTopic(TopicName)”将使整个主题完整,但是没有图像。我尝试了ExportImages,但是这个不存在

显式选项

'####Globale Konstanten/Variablen####
Const DOC_Name As String = "MJWX-Protokollformular.docx" '####Hier Dateiname von vorlage####
Dim Word_Program As Word.Application, Word_Dokument As Word.Document
Dim Word_Paragraph As Word.Paragraph
Dim TopCount As Integer
Dim MM_Program As MindManager.Application
Dim MM_Dokument As MindManager.Document

Sub Main

Dim i As Integer
Dim Zahl, ImageSize As Integer
Dim MM_Bild As MindManager.Topic
Dim MM_Layer0 , MM_Layer1 , MM_Layer2 , MM_Layer3 , MM_Layer4 As 
MindManager.Topic
Dim BildOrt As String

BildOrt = MM_Dokument.Path & "\Bilder\"
Zahl = 0
ImageSize = 100

For Each MM_Layer0 In MM_Dokument.CentralTopic.SubTopics
For Each MM_Bild In MM_Layer0.SubTopics
    If MM_Bild.HasImage Then
        MM_Bild.Image.SaveWithSize(BildOrt & Zahl & ".png", mmGraphicTypePng, ImageSize, ImageSize)
        Zahl = Zahl + 1
    End If
Next MM_Bild
For Each MM_Layer1 In MM_Layer0.SubTopics
    For Each MM_Bild In MM_Layer1.SubTopics
        If MM_Bild.HasImage Then
            MM_Bild.Image.SaveWithSize(BildOrt & Zahl & ".png", mmGraphicTypePng, ImageSize,ImageSize)
            Zahl = Zahl + 1
        End If
    Next MM_Bild
    For Each MM_Layer2 In MM_Layer1.SubTopics
        For Each MM_Bild In MM_Layer2.SubTopics
            If MM_Bild.HasImage Then
                MM_Bild.Image.SaveWithSize(BildOrt & Zahl & ".png", mmGraphicTypePng, ImageSize,ImageSize)
                Zahl = Zahl + 1
            End If
        Next MM_Bild
        For Each MM_Layer3 In MM_Layer2.SubTopics
            For Each MM_Bild In MM_Layer3.SubTopics
                If MM_Bild.HasImage Then
                    MM_Bild.Image.SaveWithSize(BildOrt & Zahl & ".png", mmGraphicTypePng, ImageSize,ImageSize)
                    Zahl = Zahl + 1
                End If
            Next MM_Bild
            For Each MM_Layer4 In MM_Layer3.SubTopics
                For Each MM_Bild In MM_Layer4.SubTopics
                    If MM_Bild.HasImage Then
                        MM_Bild.Image.SaveWithSize(BildOrt & Zahl & ".png", mmGraphicTypePng, ImageSize,ImageSize)
                        Zahl = Zahl + 1
                    End If
                Next MM_Bild
            Next MM_Layer4
        Next MM_Layer3
    Next MM_Layer2
Next MM_Layer1
Next MM_Layer0

当前结果是将图像提取到文件夹中,然后将其插入到Word文档中。有没有一种更有效的方法,因为这样做只能深入4个分支才能找到图像。

0 个答案:

没有答案