Manualy insert multiline-text in Word Labels Template from VBA Excel

[MrBadTSP]

Hello

The idea :
1 Select data : The Macro open a FilePicker to select the file.xls where the data (adresses) are. Then you choose the sheet and manualy put the columne into B4.
2 Launch : Get the data from the file/sheet/column specified in B2-B4. Then generate a Word document from Label Template "3448" and fill 24 adresses per pages, save as word/pdf.

That part is working, i got bored with from internet code so I done it from scratch (despite not being used to do some VBA, ugly code here).
I should say that part is working great with "1 line text" from the specified data, the 24 texts are well placed on the template.
No more working if the specified data are "multiline text" (with ALT+ENTER) ; the 24 texts aren't well placed on the template.

I tried some workaround ( dealing with Chr(10), Chr(13), vbCrlf,etc.. ) same problem.
Note: The data are copied from the Specified file.xls into a hidden sheet "Work" on the Main workbook (from wich I launch the macro). Then i try to put the data from "Work" into a new word template.
Note: There is a will of creating new Hidden Instances of Excel & Word instead of getting already opened one.



Here is some code: CurrentRow and LastRow are used to reference 24rows of adresses

Sub CreateAndSaveOnePage(ByVal Page As Integer, ByVal CurrentRow As Integer, ByVal LastRow As Integer)
    'Ouvre une nouvelle instance word hidden
    Set oWD = CreateObject("Word.Application")
    With oWD
    
        .Visible = False
        'créer un document word
        .Documents.Add
        'choisir le template label 3448
        Set oDoc = .MailingLabel.CreateNewDocument(Name:="3448")
            
        'template 3448 : 24 etiquettes par page; 3 colonnes de paragraphes, 8 lignes. (il y a une 4eme colonne avec les retour a la ligne, donc 4x8=32 paragraphs)
        For m = 1 To 32
            'Si le paragraphe est une etiquette : orientation 0, si c'est un retour à la ligne : orientation 9999999
            If oDoc.Paragraphs(m).Range.Orientation = 0 Then
                If CurrentRow <= LastRow Then
                    [COLOR=#ff0000]oDoc.Paragraphs(m).Range.Text = Worksheets("Work").Range("A" & CurrentRow).Value[/COLOR]
                    CurrentRow = CurrentRow + 1
                End If
            End If
        Next m
        
        'Sauvegarde document word
        oDoc.SaveAs (Application.ActiveWorkbook.Path + "\" + Format(Now(), "yyyy-mm-dd") + "_p" + CStr(Page) + "_LabelsEditiques.docx")
        'Sauvegarde document pdf
        oDoc.SaveAs2 Application.ActiveWorkbook.Path + "\" + Format(Now(), "yyyy-mm-dd") + "_p" + CStr(Page) + "_LabelsEditiques.pdf", 17
        
        
        'Fermeture de l'instance hidden word
        .Quit
    End With
    
    'release variables
    Set oWD = Nothing
    Set oDoc = Nothing
End Sub

The logic : Template '3448' consist of (3 columns by 8 rows for a total of 24 labels). I got to understand that there are in fact 32 paragraphs on the new generated doc. A 4th column exist wich are EndOfLine ( i tried to catch it with IsEndOfLineMark but never returns true ), i catch these by Range.Orientation (column 1-3 Orientation = 0 , column 4 Orientation = 999999).





Use Case okay: (sheet 2 D:D -> single line text)
1- Open "GenerateurEditique.xls", click on button "Choisir Fichier", filePicker choose "Adresses.xls"
2- Click on "sheet 2" in ListBox
3- Manualy type text the text "D" into B4
4- Click on button "Générer un document Word d'Etiquettes"
5- Enjoy good output

Use Case NOT okay: (sheet 1 B:B -> multiline text)
1- Open "GenerateurEditique.xls", click on button "Choisir Fichier", filePicker choose "Adresses.xls"
2- Click on "sheet 1" in ListBox
3- Manualy type text the text "B" into B4
4- Click on button "Générer un document Word d'Etiquettes"
5- Do Not Enjoy bad output


Your thoughts are higly appreciated

Regards,
MrBadTSP

PS: files here http://s000.tinyupload.com/index.php?file_id=25475903505084180086

 

[Ludo S]

<snip>

Hi,
I can't follow your question exactly, and the exel files are removed.
i have no experience with Word VBA, it's also try and error.
i played a bit with your code and made some changes to it, as you can see in the code here below.

I hope you can use it.
see also the french text in the code

expanation in short:

• define variables,
• open a new instance of Word if there's none open, if Word exist, skip it and use the existing instance of Word.
• preset lValue to 100 = starting number to fill the label cells. change it to your needs
• open a new label template "3448" and save the file name (not been used in the code)
• set reference to the table
• count the number of columns & rows in the table - no need to know in advance!
• we fill the table cells row by row until the last cell - we start with 100 and increment the value with 1
• at the end we center the values horizontally in the cells (vertical center alignment not possible?)
• save the file as a docx & PDF file (not been tested!)
• and finally close Word.

Sub CreateOnePage()
    Dim oWd As Object                   'Word object
    Dim oDoc As Object                  'Label document object
    Dim t As Table                      'table object
    
    Dim sLabelTemplateName As String    'Label template name
    Dim sValue As String                'value as string
    Dim lValue As Long                  'value as long
    Dim CurrentRow As Integer           'current row to fill
    Dim CurrentColumn As Integer        'current column to fill
    Dim LastRow As Integer              'last row in table
    Dim iColumnCount As Integer         'columns in label template
    Dim iRowCount As Integer            'rows in label template
    
'preset value as example
    lValue = 100
'Create a new instance of the Word application, if an existing Word object is not available.
'Créer une nouvelle instance de l'application Word, si un objet de Word existant ne sont pas disponibles.


'Set the Application object as follows:
'Réglez l'objet Application comme suit:
    On Error Resume Next
    Set oWd = GetObject(, "Word.Application")
'if an instance of an existing Word object is not available, an error will occur (Err.Number = 0 means no error):
'si une instance d'un objet Word existant ne sont pas disponibles, une erreur se produira (Err.Number = 0 signifie pas d'erreur):
    If Err.Number <> 0 Then
        Set oWd = CreateObject("word.Application")
    End If
'disable error handling:
    On Error GoTo 0
'
    With oWd
        .Visible = False
'open template label with the name as can be seen in the 'Envelope & Labels' form.
'ouvert étiquette de modèle avec le nom comme on peut le voir dans la forme «Enveloppe & Labels».
'        Set oDoc = .MailingLabel.CreateNewDocument(Name:="HERMA 4212 - SuperPrint")
        Set oDoc = .MailingLabel.CreateNewDocument(Name:="3448")
        
'place the active document name into variable (not been used so far)
'placer le nom du document actif dans la variable
        sLabelTemplateName = ActiveDocument.Name

'set reference to the table
'régler la référence sur le tableau
        Set t = oDoc.Tables(1)
        
'get the number of columns in the table
'obtenir le nombre de colonnes dans la table
        iColumnCount = t.Columns.Count
        
'get the number of rows in the table
'obtenir le nombre de lignes  dans la table
        iRowCount = t.Rows.Count
'
        LastRow = iRowCount
        
'preset current row & column (= cell in upper left corner)
'prédéfini ligne actuelle et la colonne (= cellule dans le coin supérieur gauche)
        CurrentRow = 1
        CurrentColumn = 1
        
'fill all table cells, starting with the lValue (=100)
'remplir toutes les cellules de la table, en commençant par le lValue (= 100)
        While CurrentRow <= LastRow
            If CurrentColumn <= iColumnCount Then
                sValue = CStr(lValue)
                t.Cell(CurrentRow, CurrentColumn).Range.Text = sValue
                CurrentColumn = CurrentColumn + 1
                lValue = lValue + 1
            Else
                CurrentColumn = 1
                CurrentRow = CurrentRow + 1
            End If
        Wend
        
'center data in the cells
'centres données dans les cellules
        t.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter

'les codes ici ne sont pas contrôle si ils marché ou pas!
'        'Sauvegarde document word
        oDoc.SaveAs (Application.Activeworkbook.Path & "\" & Format(Now(), "yyyy-mm-dd") & "_p" & CStr(Page) & "_LabelsEditiques.docx")
'        'Sauvegarde document pdf
        oDoc.SaveAs2 Application.Activeworkbook.Path & "\" & Format(Now(), "yyyy-mm-dd") & "_p" & CStr(Page) & "_LabelsEditiques.pdf", 17
        
        'Fermeture de l'instance hidden word
        .Quit
    End With
    
    'release variables
    Set oWd = Nothing
    Set oDoc = Nothing
    Set t = Nothing
End Sub

Bonne chanche.

Regards/Cordialement
Ludo
(Flandre - Belqique)</snip>