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 59 60 61 62 63 64 65 66
| 'VERIFICATION DES PAGES DE DEBUT ET DE FIN
If FrmMain.TxtPageStart.Text <> "" Then
If CInt(FrmMain.TxtPageStart.Text) > FrmMain.LVStats.ListItems.Count Or CInt(FrmMain.TxtPageStart.Text) > CInt(FrmMain.TxtPageEnd.Text) Or CInt(FrmMain.TxtPageStart.Text) < 1 Then
FrmMain.TxtPageStart.Text = "1"
End If
Else
FrmMain.TxtPageStart.Text = "1"
End If
If FrmMain.TxtPageEnd.Text <> "" Then
If CInt(FrmMain.TxtPageEnd.Text) < 0 Or CInt(FrmMain.TxtPageEnd.Text) < CInt(FrmMain.TxtPageStart.Text) Or CInt(FrmMain.TxtPageEnd.Text) > FrmMain.LVStats.ListItems.Count Then
FrmMain.TxtPageEnd.Text = CStr(FrmMain.LVStats.ListItems.Count)
End If
Else
FrmMain.TxtPageEnd.Text = CStr(FrmMain.LVStats.ListItems.Count)
End If
'Set doc = GetObject(Chemin & "LETTRE_REFUS.doc")
Set AppWord = CreateObject("Word.Application")
'je cache l'application
'AppWord.Visible = False
AppWord.Visible = True
'ouverture d'un document
If Gtype <> "Formule individuelle" Then
AppWord.Documents.Open (DocPathcoupl)
Else
AppWord.Documents.Open (DocPath)
End If
'j'affiche word avec le document ouvert
AppWord.Visible = True
'je le minimise
AppWord.WindowState = wdWindowStateMinimize
'je crée une référence à mon document celui que j'ai ouvert :o)
If Gtype <> "Formule individuelle" Then
MsgBox DocPathcoupl
Set DocWord = AppWord.Documents.Item(DocPathcoupl)
Else
Set DocWord = AppWord.Documents.Item(DocPath)
End If
'si mon document contient un mailmerge
'If DocWord.MailMerge.State = wdMainAndDataSource Then (ME 20130812)
With DocWord.MailMerge
'.DataSource.QueryString = "SELECT * FROM " & TPublipostage & ""
.OpenDataSource Name:="", _
Connection:="DSN=MySQLServerDSN;DATABASE=MyDATABASE;uid=MyUID;pwd=MyPWD;", _
SQLStatement:="Select * from " & TPublipostage & " ", _
SubType:=wdMergeSubTypeWord2000
.Destination = wdSendToNewDocument
.Execute Pause:=False
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = True
With .DataSource
.QueryString = "SELECT * FROM " & TPublipostage & ""
.FirstRecord = CInt(FrmMain.TxtPageStart.Text)
'Une seule page pour les tests
.LastRecord = CInt(FrmMain.TxtPageEnd.Text)
End With
End With
With DocWord
.MailMerge.Destination = wdSendToNewDocument
.MailMerge.Execute Pause:=False
End With |
Partager