Ucfoutu, merci bcp pour votre réponse. J'ai pensé que tout le monde ne s’intéressait plus au dev. vb6... Désolé Ucfoutu. Par la suite ci-joint le CS, ainsi une partie du code de pilotage ms word. Mais comment pourrai-je envoyer le CS?? (pas de menu d'upload !!!)
Private Sub Command2_Click()
Dim isaligne As Integer
Dim isacolonne As Integer
Dim i, j As Integer
Dim se As Long
Dim sav As String
Dim theError As Long
Dim remplsql2 As String
KillProcess "WINWORD.exe"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set Rt = New ADODB.Recordset
sql1 = "SELECT mpandray.* FROM mpandray"
''''''''''''''''''''''''''''''''''''''''''''''''''
remplsql2 = ""
If Text1.Text <> "" Then
remplsql2 = remplsql2 & "AND mpandray.mpandray_Anarana like '%" & Text1.Text & "%'"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
If Combo1.ListIndex > -1 Then
remplsql2 = remplsql2 & "AND mpandray.mpandray_LsaV = '" & Combo1 & "'"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
If Combo2.ListIndex > -1 Then
remplsql2 = remplsql2 & "AND mpandray.mpandray_Faritany = '" & Combo2 & "'"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
If Text2.Text <> "" Then
remplsql2 = remplsql2 & "AND mpandray.mpandray_Andraikitra_hafa like '%" & Text2.Text & "%'"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
If remplsql2 <> "" Then
sql1 = sql1 & " WHERE " & Right(remplsql2, (Len(remplsql2) - 4))
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
sql1 = sql1 & " ORDER BY mpandray.mpandray_Faritany, mpandray.mpandray_LsaV, mpandray.mpandray_Anarana"
Rt.Open sql1, bd, 1, 3
Dim isas As Integer
isas = Rt.RecordCount + 1
''''''''''''''''''''''''''''''''''''''''''''''
'ouvre Word
'True pour word visible et false pour le mettre en arrière plan
Dim docWord As Word.Application
On Error Resume Next
Set docWord = GetObject("", "Word.Application")
If Err <> 0 Then
'If GetObject fails Then use CreateObject instead.
Set docWord = CreateObject("Word.Application")
End If
'Set docWord = CreateObject("word.application")
'docWord.Visible = True
docWord.ScreenUpdating = True
docWord.DisplayAlerts = False 'évite les erreurs de traitement
docWord.Documents.Add 'ajoute un document vierge
docWord.ActiveWindow.WindowState = wdWindowStateMinimize
docWord.Activate
'Mise en forme d'entête et pied de page
With docWord.ActiveDocument.Sections(1)
.Headers(wdHeaderFooterPrimary).Range.Font.Name = "Trebuchet MS"
.Headers(wdHeaderFooterPrimary).Range.Font.Size = 10
.Headers(wdHeaderFooterPrimary).Range.Text = "FJKM Ziona Salazamay TOAMASINA"
.Headers(wdHeaderFooterPrimary).Range.Underline = True
.Headers(wdHeaderFooterPrimary).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Footers(wdHeaderFooterPrimary).Range.Font.Name = "Trebuchet MS"
.Footers(wdHeaderFooterPrimary).Range.Font.Size = 8
.Footers(wdHeaderFooterPrimary).Range.Text = "Auteur: Rantsana Informatika"
.Footers(wdHeaderFooterPrimary).PageNumbers.NumberStyle = wdPageNumberStyleArabic
.Footers(wdHeaderFooterPrimary).PageNumbers.Add
'Mise en forme titre
docWord.Selection.ParagraphFormat.LeftIndent = docWord.InchesToPoints(-0.4)
docWord.Selection.Font.Size = 11
docWord.Selection.Font.Underline = wdUnderlineNone
docWord.Selection.Font.Name = "Trebuchet MS"
docWord.Selection.Borders.InsideColor = wdColorBlue
'docword.Selection.TypeText Text:=vbCrLf & vbCrLf
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Text1.Text <> "" Then
docWord.Selection.Font.Underline = wdUnderlineWords
docWord.Selection.Font.Size = 8
docWord.Selection.TypeText Text:="Anarana misy litera: " & vbTab '& vbTab & vbTab
docWord.Selection.Font.Underline = wdUnderlineNone
docWord.Selection.Font.Italic = True
docWord.Selection.Font.Color = wdColorRed
docWord.Selection.Font.Size = 11
docWord.Selection.TypeText Text:=Text1.Text & vbCrLf
End If
If Combo1.Value <> "" Then
docWord.Selection.Font.Underline = wdUnderlineWords
docWord.Selection.Font.Size = 8
docWord.Selection.Font.Color = wdColorBlack
docWord.Selection.Font.Italic = False
docWord.Selection.TypeText Text:="L sa V: " & vbTab & vbTab & vbTab
Dim aq As String
If Combo1.Value = "L" Then
aq = "Lehilahy"
Else
aq = "Vehivavy"
End If
docWord.Selection.Font.Underline = wdUnderlineNone
docWord.Selection.Font.Italic = wdToggle
docWord.Selection.Font.Color = wdColorRed
docWord.Selection.Font.Size = 11
docWord.Selection.TypeText Text:=aq & vbCrLf '& vbCrLf & vbCrLf
End If
If Combo2.Value <> "" Then
docWord.Selection.Font.Underline = wdUnderlineWords
docWord.Selection.Font.Size = 8
docWord.Selection.Font.Color = wdColorBlack
docWord.Selection.Font.Italic = False
docWord.Selection.TypeText Text:="Faritany: " & vbTab & vbTab '& vbTab
docWord.Selection.Font.Underline = wdUnderlineNone
docWord.Selection.Font.Italic = True
docWord.Selection.Font.Color = wdColorRed
docWord.Selection.Font.Size = 11
docWord.Selection.TypeText Text:=Combo2.Value & vbCrLf '& vbCrLf & vbCrLf
End If
If Text2.Text <> "" Then
docWord.Selection.Font.Underline = wdUnderlineWords
docWord.Selection.Font.Size = 8
docWord.Selection.Font.Color = wdColorBlack
docWord.Selection.Font.Italic = False
docWord.Selection.TypeText Text:="Andraikitra misy litera: " & vbTab '& vbTab & vbTab
docWord.Selection.Font.Underline = wdUnderlineNone
docWord.Selection.Font.Italic = True
docWord.Selection.Font.Color = wdColorRed
docWord.Selection.Font.Size = 11
docWord.Selection.TypeText Text:=Text2.Text & vbCrLf '& vbCrLf & vbCrLf
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
docWord.Selection.Font.Italic = False
docWord.Selection.TypeParagraph
'Mise en forme tableau
'Entête
docWord.Selection.Tables.Add Range:=Selection.Range, NumRows:=isas, NumColumns:=6
docWord.Selection.Range.Columns(1).Width = 25
docWord.Selection.Range.Columns(2).Width = 250
docWord.Selection.Range.Columns(3).Width = 30
docWord.Selection.Range.Columns(4).Width = 80
docWord.Selection.Range.Columns(5).Width = 60
docWord.Selection.Range.Columns(6).Width = 30
docWord.Selection.Range.Rows(1).Shading.BackgroundPatternColor = wdColorBlueGray
docWord.Selection.Range.Rows.Height = 20
docWord.Selection.Font.Color = wdColorWhite
docWord.Selection.TypeText Text:="N°"
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorWhite
docWord.Selection.TypeText Text:="Anarana sy fanampiny"
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorWhite
docWord.Selection.TypeText Text:="L/V"
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorWhite
docWord.Selection.TypeText Text:="Andraikitra"
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorWhite
docWord.Selection.TypeText Text:="Finday"
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorWhite
docWord.Selection.TypeText Text:="Far."
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Contenu du tableau
Do Until Rt.EOF
Dim isa As Integer
For isa = 1 To isas - 1
'Rang_parti, Space, len
'''''''''''''''''''''''''''
'docWord.Selection.Range.Rows.Shading.BackgroundPatternColor = wdColorGray05
docWord.Selection.MoveStart
docWord.Selection.Font.Underline = wdUnderlineNone
docWord.Selection.Font.Color = wdColorRed
docWord.Selection.TypeText Text:=isa
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorAutomatic
docWord.Selection.TypeText Text:=Rt.Fields("mpandray_Anarana").Value
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.MoveRight
docWord.Selection.TypeText Text:=Rt.Fields("mpandray_LsaV").Value
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorRed
docWord.Selection.TypeText Text:=Rt.Fields("mpandray_Andraikitra_hafa").Value
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorAutomatic
docWord.Selection.TypeText Text:=Rt.Fields("mpandray_finday1").Value
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.MoveRight
docWord.Selection.Font.Color = wdColorAutomatic
docWord.Selection.TypeText Text:=Rt.Fields("mpandray_Faritany").Value
docWord.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
docWord.Selection.Range.Rows.Height = 20
'docWord.Selection.Range.Rows.Shading.BackgroundPatternColor = wdColorGray05
Rt.MoveNext
'docword.Selection.MoveDown
Next isa
Loop
Rt.Close
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'saut de page
'docword.Selection.InsertBreak Type:=wdSectionBreakNextPage
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sav = sav & Format(Date, "ddmmyy") & Format(Time, "hms")
If Dir(App.Path & "\Print\" & sav & ".doc", vbHidden) <> "" Then
Dim qst As String
qst = MsgBox("Le fichier existe déjà!" & vbCrLf & "Voulez-vous écraser?", vbYesNo, "Attention!")
If qst = vbYes Then
docWord.ActiveDocument.SaveAs App.Path & "\Print\" & sav & ".doc"
'docWord.ActiveDocument.Close
'docWord.ActiveDocument.Save NoPrompt:=True
End If
Else
docWord.ActiveDocument.SaveAs App.Path & "\Print\" & sav & ".doc"
'docWord.ActiveDocument.Close
'docWord.ActiveDocument.Save NoPrompt:=True
End If
Dim qsta As String
qsta = MsgBox("Hojerena ve sa tsia", vbYesNo, "Filazana!")
If qsta = vbYes Then
docWord.ActiveWindow.WindowState = wdWindowStateMaximize
Else
Set docWord = Nothing
docWord.ActiveDocument.Close
docWord.Quit
KillProcess "WINWORD.exe"
Unload Me
frmlistmpandray.Show
End If
End Sub