Newsgroup: it.comp.lang.visual-basic
Titolo: Stampa Unione con Visual Basic 6

Ciao a tutti,
qualcuno mi sa indicare un progetto di esempio per effettuare la stampa 
unione con Visual Basic 6.
Mi spiego meglio.
Ho un modello modello.doc con inseriti i campi unione formattati, poi 
devo prendere dei dati da un db access inserire nei corrispettivi campi 
creandoe il file stampa unione con word...Grazie...Namaste


wrote:

Eh eh eh di quanto tempo disponi?
Vediamo se ti dò una infarinatura e poi prosegui da te....
l'ho fatto agli inizi...poi ho convinto il cliente a non farlo più!
E' deprecato dalla stessa microsoft comandare Word ...sei soggetto a
crash...basta che word rallenti a chiudere un documento o succeda
qualcosa per far esplodere tutto!
CMQ se ti vuoi far del male.....
ti recupero un po di codice....
commondialog per scegliere il modello
With Me.cmdScegliLettera
    .DialogTitle = "Selezionare il modello di lettera salvato"
    .InitDir = App.Path & "\mailmerge\doctipo\"
    .Filter = "Modello di Microsoft Word (*.dot)|*.dot"
    .FilterIndex = 1
    .ShowOpen
    MODELLOLETTERA = .FileName
End With
Segue un msgbox che conferma quello che si vuol fare
testo = "Si vuole stampare le lettere con i dati dell'ultima ricerca
?" + vbCrLf
testo = testo & "" + vbCrLf
testo = testo & "Scegliere ""SI"" per stampare le lettere con i dati
risultanti dall'ultima ricerca effettuata." + vbCrLf
testo = testo & "" + vbCrLf
testo = testo & "Scegliere ""NO"" per stampare le lettere con i dati
di una precedente ricerca archiviata" + vbCrLf
testo = testo & "" + vbCrLf
testo = testo & "Scegliere ""ANNULLA"" per abbandonare la procedura e
tornare alla ricerca" + vbCrLf
testo = testo & "" + vbCrLf
testo = testo & "" + vbCrLf
risp = MsgBox(testo, vbInformation + vbYesNoCancel + vbDefaultButton1,
"Seleziona dati da stampare")
Select Case risp
    Case vbYes
        WordMailMerge
    Case vbNo
        WordMailMerge , True
    Case vbCancel
 
End Select
La funzione che fa il mailmerge
Private Function WordMailMerge(Optional nomefile As String = "",
Optional MostraScegliFile As Boolean = False)
Dim FileDatasource As String
Dim MYdocs As Object
Dim Lettera As Object
Dim MyMerge As Object
If Len(Trim(MODELLOLETTERA)) <= 0 Then
    MsgBox "Nessuno modello di lettera scelto per fondere i dati",
vbCritical, "Impostare modello lettera tipo"
    Exit Function
End If
Set MYdocs = CreateObject("Word.Application")
Set Lettera = CreateObject("Word.Document")
MYdocs.Visible = True
MYdocs.Documents.Open MODELLOLETTERA
Set Lettera = MYdocs.ActiveDocument
'mailmerge
If nomefile = "" Then
    If MostraScegliFile = False Then
        FileDatasource = App.Path & "\mailmerge\" &
NomeFileUltimaStampa
    Else
        With Me.cmdScegliFileStampa
            .InitDir = App.Path & "\mailmerge\"
            .DialogTitle = "Seleziona la stampa da effettuare tra
quelle memorizzate"
            .DefaultExt = "mpt"
            .Filter = "Stampe memorizzate(*.mpt)|*.mpt|Tutti i file
(*.*)|*.*|"
            ' Specifica il filtro predefinito.
            .FilterIndex = 1
            .Flags = cdlOFNHideReadOnly
            .ShowOpen
          FileDatasource = .FileName
        End With
    End If
Else
End If
DoEvents
Set MyMerge = MYdocs.ActiveDocument.MailMerge
'per provare
Const DontConfirmConversions = False
Const OpenReadOnly = True
Const DontLinkToSource = False
Const DontAddToRecentFiles = False
Const NoPasswordDocument = ""
Const NoPassWordTemplate = ""
Const Revert = True
Const DontWritePasswordDocument = False
Const DontWritePassWordTemplate = False
Const NoConnection = ""
Const NoSql = ""
On Error Resume Next
MyMerge.OpenDataSource FileDatasource, 5, False, True, False, False,
"", "", False, "", "", "", "", ""
MyMerge.Execute
DoEvents
FILEDATIMERGE = FileDatasource
On Error GoTo 0
End Function
così come è non funzionerà mai però....ha bisogno dei dati da fondere
Dove stà l'idea....i dati da fondere li ho generati come file di
testo...nello specifico questi derivano da una query sugli archivi!
Per fare generare questo file ho sputato parecchio sangue...perchè si
incasina sui delimitatori..ne salti uno o lo chiudi male (uno spazio
che salta) e word si rifiuta di mangiare il tuo file!
Dove sta questa routine......eccola qua
Private Function StampaDocumenti() As Boolean
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'Si deve trovare i dati da stampare
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Dim FileStampa As String
Dim Itemx As ListItem
Dim myRECS As Long
Dim myREC As Long
Dim riga As Long
Dim maxrighe As Long
Dim nFile As Long
Dim nomefile As String
Dim RECriga As String
Dim dummy As String
....salto quello che c'è qui
If MyRecF Is Nothing Then
    MsgBox "Attenzione cliccare su ""avvio ricerca nominativi"" per
generare una ricerca", vbCritical, "Procedura non completata"
    StampaDocumenti = False
    Exit Function
End If
If MyRecF.EOF And MyRecF.BOF Then
    MsgBox "Nessun dato da stampare", vbInformation, "Attenzione!!!"
    StampaDocumenti = False
    Exit Function
End If
MyRecF.MoveLast
myRECS = MyRecF.RecordCount
MyRecF.MoveFirst
'QUI TI INTERESSA
si crea il file di testo con un nome derivante dalla data
nFile = FreeFile
nomefile = "ElencoPerWord[" & CStr(Day(Date)) & "-" &
CStr(Month(Date)) & "-" & CStr(Year(Date))
nomefile = nomefile & "-" & CStr(Time) & "].mpt"
Open (App.Path & "\MailMerge\" & nomefile) For Output As nFile
'Scrive header con nomi campi
RECriga =
"Titolo#Nome#Cognome#Indirizzo#Città#Provincia#CAP#Regione#CAformula#CApersona"
Print #nFile, RECriga
'scritta intestazione
l'intestazione è importante...raccoglie tutti i tuoi campi che DEVONO
essere presenti nel modello da fondere...CON IL SOLITO ESATTO NOME!!!
nel mio specifico i dati derivanti dalla query sono mostrati in un
listview e l'utente può deselezionando il check stamparne solo alcuni
RECriga = ""
maxrighe = LWr.ListItems.Count
For riga = 1 To maxrighe
Set Itemx = LWr.ListItems(riga)
    If Itemx.Checked Then
        'va stampato
        'RIGA -1 Perchè il recordset inizia dalla posizione 0!
        MyRecF.AbsolutePosition = riga - 1
        'Pulisce la variabile che conterrà una riga
        RECriga = ""
        '============================================
        'Parsing valori
        '============================================
        dummy = (MyRecF("Titolo") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = """" & RECriga & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
        dummy = (MyRecF("Nome") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
        dummy = (MyRecF("Cognome") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
 
        dummy = (MyRecF("Indirizzo") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
        dummy = (MyRecF("Citta") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
        dummy = (MyRecF("Provincia") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
        dummy = (MyRecF("CAP") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
 
        dummy = (MyRecF("Regione") & "")
        If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """#"
        Else
            RECriga = RECriga & C_FILECHARNULL
        End If
       ' ESPERIMENTO!
 
       ' dummy = (MyRecF("CA") & "")
       ' If Len(Trim(dummy)) > 0 Then
       '     RECriga = RECriga & """" & dummy & """"
       ' Else
       '     RECriga = RECriga & "#"""""
       ' End If
 
       ';;;;;;;;;;;;VERSIONE MODIFICATA
       '#CAformula
        If Len(C_FORMULACA) = 0 Then
            RECriga = RECriga & C_FILECHARNULL
        Else
            RECriga = RECriga & """" & C_FORMULACA & """#"
        End If
       '#CApersona
       dummy = (MyRecF("CA") & "")
       If Len(Trim(dummy)) > 0 Then
            RECriga = RECriga & """" & dummy & """"
        Else
            RECriga = RECriga & """"""
        End If
 
 
       ALLA FINE LA RIGA CHE SI E' COSTRUITA LA SCRIVE NEL FILE 
 
        'scrive nel file
        Print #nFile, RECriga
 
    End If
.......    
Next
Close #nFile
NomeFileUltimaStampa = nomefile
StampaDocumenti = True
End Function
In qesto modo l'utente clicca sulla sua ricerca vede partire per un
attimo word e generarsi automaticamente la stampa unione.....magia
delle magie!
Al 5° crash perchè la segretaria cretina non aspettava la fine delle
stampe ...ma chiudeva lei a mano word (perchè gli dava noia)....gli ho
convinti ad usare un sistema di report interno!
E siamo compati TUTTI più tranquilli!!!
Ho buttato via una decina di giorni di impazzamento intorno a Word ed
alle sue assurde idiosincrasie!!!...ma son stato contento...il mio
stomaco ringrazia!
per chi non lo sapesse son contento di Reportman! 
p.s.
se campi delimitatori cambia TUTTO di conseguenza...io ho usato #
perchè ero sicuro che NON me lo piazzavano nel testo dei campi!
per questo 
la dichiarazione C_FILECHARNULL è esterna e nello specifico vale
C_FILECHARNULL = """""#"
Considera che tutta questa pappa scodellata che ti ritrovi è frutto di
una grande incazzatura....sìine degno/a!
:o)

Grazie,
ma penso di aver risolto con 5 righe di codice.

ma penso di aver risolto con 5 righe di codice.
quali sono?

    Set objWord = GetObject(App.Path + "\Modello.dot", "Word.Document")
    objWord.Application.Visible = False
    objWord.MailMerge.OpenDataSource _
       Name:=App.Path + "\db10.mdb", _
       LinkToSource:=True, _
       SQLStatement:="SELECT * FROM [Clienti]"
    objWord.MailMerge.Destination = wdSendToNewDocument
    'objWord.MailMerge.Destination = wdSendToPrinter
objWord.MailMerge.Execute
objWord.Application.Options.PrintBackground = False
objWord.Application.ActiveDocument.ActiveWindow.Visible = True
Naturalmente con il Modello.dot ben formattato.


wrote:
č un altro sistema...sprechi un po di risorse....ma l'importante č che
funzioni....!:o)
Nel mio codice ti fai un file di testo e gli fai mangiare quello a
word...il vantaggio č che si possono archiviare il file di testo e
ristamparsi quante volte vogliono quella query senza rieseguirla.
Inoltre elabora una volta sola...tu tutte le volte che lanci la stampa
ti connetti al db ed esegui una query!
.
applicazione monoutente e db piccolo non conta
nulla....altrimenti...tutto fa
Saluti!