Something lilke mail merge function in Draw/Impress?

English
,
#1

I use Draw (could also be done in Impress) to create very similar pages. I want this to be done based on a template page and a list strings processed by a macro ore something like that. I tried to create a macro myself using AI but I failed. Maybe there is some sort of mail merge function in Draw or Impress to solve this?

Here is what I have:

  • A draw file with one page only.
  • The page contains very few elements, one of them is a text element called “Template1”.
  • Now I want to take my list of strings (could be a multi line input field or from another file) and create a new page for each entry. On this new page the content of the text element “Template1” should be replaced with the text from the file.

How would you solve this?

#2

Copy the drawing contents to a single page Writer document and do the mail merge there.

1 Like
#3

I miss expecially positioning of elements there. This part would be much easier in Draw. :frowning:

But I will install LibreOffice Base and give it a try.

#5

you can also comment in 53548 – Allow "Other" fields / DocInformation / custom editable fields in Draw/Impress (as in Writer)

#4

in a similar idea with images, you have a example → Créer des cadres pour les images ou les aligner ou faire les deux et plus en même temps - #11 by fpy

instead of reading images from a directory, you can read your strings from a file → Input# Statement

#6

I got a macro running which does the job.
It asks for the soruce page, the number of copies and the new text (offering one or two text fields per copy).

This is the code: (Sorry, comments are in German.)

Sub Wait(nMilliSeconds As Long)
    ' Wartefunktion
    Dim nStart As Long
    nStart = GetSystemTicks()
    Do While GetSystemTicks() - nStart < nMilliSeconds
        DoEvents
    Loop
End Sub

Sub CreatePagesFromTextInput()
    ' LibreOffice Draw Makro - Seiten aus Texteingabe erstellen
    Dim oDoc As Object
    Dim oFirstPage As Object
    Dim oShape As Object
    Dim sUserInput As String
    Dim aTextLines() As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim oNewPage As Object
    Dim oDialog As Object
    Dim oDialogModel As Object
    Dim oTextArea As Object
    Dim bHasErsetzungZwei As Boolean
    Dim oDispatcher As Object
    Dim oFrame As Object
    Dim oController As Object
    Dim nPagesTotal As Integer
    Dim oLastPage As Object
    Dim nPagesAfter As Integer
    Dim sShapeName As String
    
    ' Aktuelles Dokument abrufen
    oDoc = ThisComponent
    
    ' Prüfen ob es sich um ein Draw-Dokument handelt
    If Not oDoc.supportsService("com.sun.star.drawing.DrawingDocument") Then
        MsgBox "Dieses Makro funktioniert nur in LibreOffice Draw!"
        Exit Sub
    End If
    
    ' Erste Seite abrufen
    oFirstPage = oDoc.getDrawPages().getByIndex(0)
    
    ' Prüfen ob ErsetzungZwei vorhanden ist
    bHasErsetzungZwei = False
    For j = 0 To oFirstPage.getCount() - 1
        oShape = oFirstPage.getByIndex(j)
        If oShape.supportsService("com.sun.star.drawing.TextShape") Then
            If InStr(oShape.getName(), "ErsetzungZwei") = 1 Then
                bHasErsetzungZwei = True
                Exit For
            End If
        End If
    Next j
    
    ' Dialog für mehrzeilige Texteingabe erstellen
    oDialogModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
    oDialogModel.PositionX = 100
    oDialogModel.PositionY = 100
    oDialogModel.Width = 300
    oDialogModel.Height = 250
    oDialogModel.Title = "Texteingabe für neue Seiten"
    
    ' Label und Feld für Seitennummer
    Dim oLabelPage As Object
    oLabelPage = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    oLabelPage.PositionX = 10
    oLabelPage.PositionY = 10
    oLabelPage.Width = 80
    oLabelPage.Height = 12
    oLabelPage.Label = "Seite kopieren:"
    oDialogModel.insertByName("LabelPage", oLabelPage)
    
    Dim oFieldPage As Object
    oFieldPage = oDialogModel.createInstance("com.sun.star.awt.UnoControlEditModel")
    oFieldPage.PositionX = 100
    oFieldPage.PositionY = 8
    oFieldPage.Width = 40
    oFieldPage.Height = 15
    oFieldPage.Text = "0"
    oDialogModel.insertByName("FieldPage", oFieldPage)
    
    ' Label und Feld für Anzahl Kopien
    Dim oLabelCopies As Object
    oLabelCopies = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    oLabelCopies.PositionX = 150
    oLabelCopies.PositionY = 10
    oLabelCopies.Width = 60
    oLabelCopies.Height = 12
    oLabelCopies.Label = "Wie oft:"
    oDialogModel.insertByName("LabelCopies", oLabelCopies)
    
    Dim oFieldCopies As Object
    oFieldCopies = oDialogModel.createInstance("com.sun.star.awt.UnoControlEditModel")
    oFieldCopies.PositionX = 220
    oFieldCopies.PositionY = 8
    oFieldCopies.Width = 40
    oFieldCopies.Height = 15
    oFieldCopies.Text = "1"
    oDialogModel.insertByName("FieldCopies", oFieldCopies)
    
    ' Textbereich hinzufügen (nach unten verschoben)
    oTextArea = oDialogModel.createInstance("com.sun.star.awt.UnoControlEditModel")
    oTextArea.PositionX = 10
    oTextArea.PositionY = 35
    oTextArea.Width = 280
    oTextArea.Height = 170
    oTextArea.MultiLine = True
    oTextArea.VScroll = True
    If bHasErsetzungZwei Then
        oTextArea.Text = "Text für ErsetzungEins Seite 2" & Chr(10) & "Text für ErsetzungZwei Seite 2"
    Else
        oTextArea.Text = "Text für Seite 2" & Chr(10) & "Text für Seite 3"
    End If
    oDialogModel.insertByName("TextArea", oTextArea)
    
    ' OK Button hinzufügen (nach unten verschoben)
    Dim oButton As Object
    oButton = oDialogModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
    oButton.PositionX = 220
    oButton.PositionY = 220
    oButton.Width = 50
    oButton.Height = 20
    oButton.Label = "OK"
    oButton.PushButtonType = 1
    oDialogModel.insertByName("OKButton", oButton)
    
    ' Dialog anzeigen
    oDialog = CreateUnoService("com.sun.star.awt.UnoControlDialog")
    oDialog.setModel(oDialogModel)
    oDialog.createPeer(CreateUnoService("com.sun.star.awt.Toolkit"), Nothing)
    
    If oDialog.execute() = 1 Then
        sUserInput = oDialog.getControl("TextArea").getText()
        Dim nSourcePage As Integer
        Dim nCopyCount As Integer
        nSourcePage = Val(oDialog.getControl("FieldPage").getText())
        nCopyCount = Val(oDialog.getControl("FieldCopies").getText())
    Else
        MsgBox "Abgebrochen."
        oDialog.dispose()
        Exit Sub
    End If
    
    oDialog.dispose()
    
    ' Text in Zeilen aufteilen
    aTextLines = Split(sUserInput, Chr(10))
    
    ' Für jede Textzeile eine neue Seite erstellen
    For i = 0 To UBound(aTextLines)
        ' Leere Zeilen überspringen
        If Trim(aTextLines(i)) <> "" Then
            ' Prüfen ob genügend Zeilen für ErsetzungZwei vorhanden sind
            Dim bSkipThisLine As Boolean
            bSkipThisLine = False
            
            If bHasErsetzungZwei Then
                If i + 1 > UBound(aTextLines) Then
                    bSkipThisLine = True
                ElseIf Trim(aTextLines(i + 1)) = "" Then
                    bSkipThisLine = True
                End If
            End If
            
            If Not bSkipThisLine Then
                ' Dispatcher für Copy/Paste
                oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
                oFrame = oDoc.getCurrentController().getFrame()
                
                ' Zur angegebenen Seite wechseln
                Dim oSourcePage As Object
                oSourcePage = oDoc.getDrawPages().getByIndex(nSourcePage)
                oDoc.getCurrentController().setCurrentPage(oSourcePage)
                Wait 200
                
                ' Alle Shapes einzeln zur Auswahl hinzufügen
                oController = oDoc.getCurrentController()
                
                ' Erstes Shape auswählen
                If oSourcePage.getCount() > 0 Then
                    ' Array-Methode für Auswahl
                    Dim aShapes() As Object
                    ReDim aShapes(oSourcePage.getCount() - 1)
                    For j = 0 To oSourcePage.getCount() - 1
                        Set aShapes(j) = oSourcePage.getByIndex(j)
                    Next j
                    
                    ' Alle Shapes auf einmal auswählen
                    oController.select(aShapes)
                    Wait 200
                    
                    ' Kopieren
                    oDispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())
                    Wait 300
                    
                    ' VOR dem Paste: Zur letzten Seite wechseln, damit er dahinter einfügt
                    nPagesTotal = oDoc.getDrawPages().getCount()
                    oLastPage = oDoc.getDrawPages().getByIndex(nPagesTotal - 1)
                    oDoc.getCurrentController().setCurrentPage(oLastPage)
                    Wait 200
                    
                    ' Einfügen - das erstellt automatisch eine neue Seite NACH der aktuellen!
                    ' Anzahl der Kopien berücksichtigen
                    Dim nCopyLoop As Integer
                    For nCopyLoop = 1 To nCopyCount
                        oDispatcher.executeDispatch(oFrame, ".uno:Paste", "", 0, Array())
                        Wait 500
                        
                        ' Die neue Seite ist jetzt die letzte Seite
                        nPagesAfter = oDoc.getDrawPages().getCount()
                        oNewPage = oDoc.getDrawPages().getByIndex(nPagesAfter - 1)
                        
                        ' Text ersetzen
                        For k = 0 To oNewPage.getCount() - 1
                            oShape = oNewPage.getByIndex(k)
                            If oShape.supportsService("com.sun.star.drawing.TextShape") Then
                                sShapeName = oShape.getName()
                                
                                If InStr(sShapeName, "ErsetzungEins") = 1 Then
                                    oShape.setString(Trim(aTextLines(i)))
                                ElseIf bHasErsetzungZwei And InStr(sShapeName, "ErsetzungZwei") = 1 Then
                                    If i + 1 <= UBound(aTextLines) Then
                                        oShape.setString(Trim(aTextLines(i + 1)))
                                    End If
                                End If
                            End If
                        Next k
                    Next nCopyLoop
                End If
                
                Wait 200
                
                ' Bei ErsetzungZwei: nächste Zeile überspringen, da sie schon verarbeitet wurde
                If bHasErsetzungZwei Then
                    i = i + 1
                End If
            End If
        End If
    Next i
    
    ' Zurück zur ersten Seite
    oDoc.getCurrentController().setCurrentPage(oFirstPage)
    
    MsgBox "Makro erfolgreich ausgeführt!"
End Sub
``

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.