Re : Publipostage à l'envers:
j'ai une erreur de compilation avec le script quand je le modifie comme ci dessous:
Option Explicit
Sub Etiquettes_Word()
Dim NDF As String
Dim WordApp As Object
Dim WordDoc As Object
Dim i As Integer, j As Integer
Dim LigneXL As Integer
Dim tatiak As String
LigneXL = ActiveSheet.Range("A65000").End(xlUp).Row + 1
NDF = Application.GetOpenFilename
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
With WordApp
.Visible = False
For NbTableaux = 1 To WordDoc.tables.Count
With WordDoc.tables(1)
For i = 1 To .Rows.Count
For j = 1 To 3
tatiak = .Cell(i, j).Range.Text
ActiveSheet.Cells(LigneXL, 1).Value = PartieLigne(1, tatiak)
ActiveSheet.Cells(LigneXL, 2).Value = PartieLigne(2, tatiak)
ActiveSheet.Cells(LigneXL, 3).Value = Mid(PartieLigne(3, tatiak), 1, 5)
ActiveSheet.Cells(LigneXL, 4).Value = Mid(PartieLigne(3, tatiak), 7)
LigneXL = LigneXL + 1
Next j
Next i
End With
End With
Next NbTableaux
WordApp.Application.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox (" Acquisition Ok")
End Sub
Function PartieLigne(N As Byte, S As String) As String
Dim Caract As String
Dim i As Integer, j As Integer, nb13 As Integer
PartieLigne = ""
i = 1
nb13 = 0
Caract = Mid(S, i, 1)
Do
Do
Caract = Mid(S, i, 1)
i = i + 1
Loop Until Caract = Chr$(13)
nb13 = nb13 + 1
Loop Until nb13 = N
j = i
Do
Caract = Mid(S, j, 1)
j = j + 1
Loop Until Caract = Chr$(13)
PartieLigne = Mid(S, i + 1, j - i)
End Function