Newsgroup: it.comp.lang.visual-basic
Titolo: Stampa da vb in Winword

Ciao,
ho creato il modulo sotto nella mia applicazione in vb che mi permette di
creare dei report in Winword selezionando le informazioni da un DB Access
(range di date).
Il tutto funziona bene quando si tratta di poche pagine, ma già con una
settantina di pagine o più il tutto rallenta considerevolmente.
C'è un sistema per velocizzare questo processo ?
    Dim xWord As Word.Application ' L'applicazione Word
    Dim xRange As Range           ' Oggetto Range
    Dim xSelection As Find        ' Oggetto Find
    Dim xTabella As Table         ' Oggetto Tabella
    Dim xCella As Cell            ' Oggetto Cella
    'istanzio una nuovo oggetto Word.Application
    Set xWord = New Application
    'Rendo invisibile l'instanza
    xWord.Visible = False
    'Se fosse visibile, potrei massimizzare la finestra con
    'la seguente riga di codice
    'xWord.WindowState = wdWindowStateMaximize
    'aggiungo un documento (in questo caso un modello)
    xWord.Documents.Add App.Path & "\" & Constant.MasterDoc
    'imposto i vari dati (qui naturalmente sostituirai i dati con quelli
    'presi da un DB. I campi contrassegnati con %<nome campo>% sono
corrispondenti
    'a quelli inseriti nel documento (o modello) word.
    Dim i As Integer
    Dim conn As ADODB.Connection
    Dim rs As Recordset
    Dim rs2 As Recordset
    Dim statement As String
    Dim NrTag As Integer
    Dim TableName() As String
    Dim TableField() As String
    Dim TableParagraph() As Index
    Dim InputField As String
    Dim Cicle As Integer
     Set conn = New ADODB.Connection
      conn.ConnectionString = _
          "Provider=Microsoft.Jet.OLEDB.3.51;" & _
          "Data Source=" & App.Path & "\" & Constant.DBName & ";Jet
OLEDB:Database Password=" & Constant.DBPassword & ";" & _
          "Persist Security Info=True"
      conn.Open
     ' Cerco il riferimento sull'intestatario della fattura
     If IDFacture <> 0 Then
     statement = "SELECT RefClient, RefPatient, DateFacturation FROM Facture
WHERE " & _
         "NFacture=" & IDFacture
     Cicle = 1
     Else
     ' Cerco il numero di fatture comprese nel range di date
     statement = "SELECT Count (*) FROM Facture WHERE DateFacturation >=" &
Format$(DateIni, "\#mm\/dd\/yyyy\#") & _
         " AND DateFacturation <=" & Format(DateFin, "\#mm\/dd\/yyyy\#")
     End If
     Set rs = conn.Execute(statement)
     Cicle = rs.Fields(0)
     rs.Close
'     If IDFacture <> 0 Then
     statement = "SELECT NFacture FROM Facture WHERE DateFacturation >=" &
Format$(DateIni, "\#mm\/dd\/yyyy\#") & _
         " AND DateFacturation <=" & Format(DateFin, "\#mm\/dd\/yyyy\#")
     Set rs2 = conn.Execute(statement)
     If Cicle > 100 Then
     Dim strMessaggio As String
     strMessaggio = "Confermi la stampa? "
        If MsgBox(strMessaggio, vbYesNo + vbExclamation, "Conferma stampa")
_
        = vbNo Then
        Exit Sub
        End If
     End If
     Dim idxI As Integer
     For idxI = 1 To Cicle
     IDFacture = rs2.Fields(0)
     rs2.MoveNext
     statement = "SELECT RefClient, RefPatient, DateFacturation FROM Facture
WHERE " & _
         "NFacture=" & IDFacture
     Set rs = conn.Execute(statement)
     Dim SString As String
     Dim Temp As String
     Dim RifNumber As Integer
     SString = rs.Fields(0)
     i = Len(SString)
     For i = i To 1 Step -1
     Temp = Right(SString, i)
      If left(Temp, 1) = Constant.TokenFacture Then
        RifNumber = Right(Temp, (i - 1))
      End If
     Next i
     If IsNull(rs.Fields(1)) = False Then
       Dim RifClient As String
       SString = rs.Fields(1)
       i = Len(SString)
       For i = 1 To i
       Temp = left(SString, i)
        If Right(Temp, 1) = Constant.TokenFacture Then
          RifClient = left(Temp, (i - 1))
        End If
       Next i
       Dim RefPatient As String
       RefPatient = "Réference: " & RifClient
     Else
       RefPatient = ""
     End If
     rs.Close
     ' Cerco le informazioni nella FicheIntervention
     statement = "SELECT DateIntervention, Lieu1, Lieu2, Attente2,
SansKMForfait, Remarques FROM FicheIntervention WHERE " & _
         "NFacture=" & IDFacture
     Set rs = conn.Execute(statement)
     Dim DateIntervention As String
     Dim LieuPriseCharge As String
     Dim Attente As String
     Dim Remarques As String
     If IsNull(rs.Fields(0)) = False Then
       DateIntervention = rs.Fields(0)
     Else
       DateIntervention = ""
     End If
     LieuPriseCharge = IIf(IsNull(rs.Fields(1)), "Déplacement depuis notre
centrale pour  " & rs.Fields(2), "Transport depuis " & rs.Fields(1) & " pour
" & rs.Fields(2))
     Attente = IIf(IsNull(rs.Fields(3)), "", "Attente sur place " &
rs.Fields(3) & " min.")
     Remarques = IIf(IsNull(rs.Fields(5)), "", rs.Fields(5))
'     rs.Close
     ' Cerco le informazioni sull'intestatario fattura
     statement = "SELECT Identite,Nom,Prénom,Adresse1,Adresse2,CapVille from
" & _
          "Anagraphique WHERE RefAnagraphique=" & RifNumber
     Set rs = conn.Execute(statement)
     Dim ID As String
     Dim Nom As String
     Dim Adress1 As String
     Dim Adress2 As String
     Dim CapVille As String
     If IsNull(rs.Fields(0)) = False Then
       ID = rs.Fields(0)
     Else
       ID = ""
     End If
     If IsNull(rs.Fields(2)) = False Then
       Nom = rs.Fields(1) + " " + rs.Fields(2)
     Else
       Nom = rs.Fields(1)
     End If
     If IsNull(rs.Fields(3)) = False Then
       Adress1 = rs.Fields(3)
     Else
       Adress1 = ""
     End If
     If IsNull(rs.Fields(4)) = False Then
       Adress2 = rs.Fields(4)
     Else
       Adress2 = ""
     End If
     CapVille = rs.Fields(5)
     rs.Close
     ' Cerco l'informazione sulla località
     statement = "SELECT Texte From Base WHERE TagDonnéeBase='Lieu'"
     Set rs = conn.Execute(statement)
     Dim Lieu As String
     Lieu = rs.Fields(0)
     rs.Close
    ' Applico le sostituzioni
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Invoice%", , , , , , , , , IDFacture, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Id%", , , , , , , , , ID, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Name%", , , , , , , , , Nom, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Adress1%", , , , , , , , , Adress1, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Adress2%", , , , , , , , , Adress2, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%City%", , , , , , , , , CapVille, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Lieu%", , , , , , , , , Lieu, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Date%", , , , , , , , , Format(Now, "dd.mm.yyyy"),
True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%RefPatient%", , , , , , , , , RefPatient, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%DateIntervention%", , , , , , , , ,
DateIntervention, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%LieuPriseCharge%", , , , , , , , ,
LieuPriseCharge, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Attente%", , , , , , , , , Attente, True
    Set xRange = xWord.ActiveDocument.Range
    xRange.Find.Execute "%Remarques%", , , , , , , , , Remarques, True
    If idxI < Cicle Then
    ' Aggiungo un nuovo documento
    Set xRange = xWord.ActiveDocument.Range
    With xRange
        .Collapse Direction:=wdCollapseEnd
        .InsertBreak wdPageBreak
        .InsertFile (App.Path & "\" & Constant.MasterDoc)
    End With
    End If
    Next idxI
    rs2.Close
    conn.Close
   'Potrei stampare il documento direttamente...
   'xWord.ActiveDocument.PrintOut
   '...oppure salvarlo in una directory con un nome...
   'xWord.ActiveDocument.SaveAs App.Path & "\Docs\" & "miodocumento.doc"
    '...ma preferiscon visualizzarlo...
    xWord.Visible = True
    '...massimizzandolo...
    xWord.WindowState = wdWindowStateMaximize
    '...e renderlo attivo!
    xWord.Application.Activate

 wrote in message
news:9lo5vf$qai$1...@news1.sunrise.ch...
