1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
| Sub publipostage()
Application.ScreenUpdating = False
Dim classeurOrigine As String, classeurPublipostage As String
classeurOrigine = ActiveWorkbook.Name
Workbooks.Add
classeurPublipostage = ActiveWorkbook.Name
[A1] = "Publipostage automatique réalisé le " & Format(Now, "dd/mm/yyyy hh:mm")
Windows(classeurOrigine).Activate
Dim table As Range
Set table = [a8].CurrentRegion
Dim ligne As Integer, colonne As Integer
For ligne = 2 To table.Rows.Count
Dim enregistrements As String, email As String
enregistrements = ""
For colonne = 1 To table.Columns.Count
enregistrements = enregistrements & table(1, colonne) & ";" & table(ligne, colonne) & "!"
Next
Debug.Print Now, ligne, enregistrements
ActiveSheet.Shapes(1).Copy
Application.Wait (Now + TimeValue("00:00:01"))
Windows(classeurPublipostage).Activate
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Application.CutCopyMode = False
Dim enregistrement As Variant, nouveauTexte As String
For Each enregistrement In Split(enregistrements, "!")
If enregistrement <> "" Then
nouveauTexte = ActiveSheet.Shapes(1).TextFrame.Characters.Text
nouveauTexte = Replace(nouveauTexte, "[" & Split(enregistrement, ";")(0) & "]", Split(enregistrement, ";")(1), 1)
ActiveSheet.Shapes(1).TextFrame.Characters.Text = nouveauTexte
If Split(enregistrement, ";")(0) = "Mail" Then
email = Split(enregistrement, ";")(1)
End If
End If
Next
creerMail email, nouveauTexte
Windows(classeurOrigine).Activate
Next
Application.ScreenUpdating = True
End Sub |
Publipostage excel vba
Répondre avec citation
Envoyé par Philippe Tulliez
Partager