Post by Giovanni ZezzaPost by Sergio MAZZASe fai tutto (apertura documento+scrittura dati) con l'automazione non hai
bisogno dei modelli; alla fine della scrittura dei dati puoi salvare il
documento con oggettoApplication.documentoAttivo.SaveAs "nomeDocumento",
renderlo visibile e lasciarlo in pasto all'utente se deve integrarlo.
D'accordo, ma in che cosa sarebbe "più semplice"? a me sembra
identicamente
la stessa cosa, quindi alla fine una questione di preferenze personale.
Personalmente trovo che non sia una cattiva idea chiamare modello quello
che si usa come modello e documento quello che si modifica; mi sembra così
meno probabile che qualcuno modifichi o cancelli il modello, non sapendo o
non ricordando a che cosa serviva. Di più, così si ha disposizione il
modello anche per l'uso interattivo.
In ogni caso, mi è difficile pensare che questo possa avere qualcosa a che
fare con il problema segnalato.
Ciao.
scusate per il ritardo nella partecipazione, ma questi sono giorni fuoco.
Per fare chiarezza vi allego il codice qasi completo del mio procedimento,
purtroppo le cose sono complicate dal fatto che le operazioni ripetitive le
ho racchiuse in procedure, comunque se avete la pazienza...
Però voglio chiarire il punto 'fondamentale' : queste procedure funzionano
perfettamente in Office XP, tanto per dirimere i dubbi sul codice.
Inoltre credo che l'approccio Modello-->Documento, oltre a essere
formalmente esatto, vada visto nello scopo stesso di tutto questo :
permettere all'utente una revisione successiva di quanto creato, quindi
preferisco rilasciargli il Documento ed avere la certezza che non mi
'sconvolga' il Modello.
Altrimenti sarebbe stato identico stampare un bel report di Access, o meglio
un PDF così come sta facendo tuttora (però non può apportare nessuna
modifica).
-----------------
Private Sub bStampaWord_Click()
On Error GoTo Err_bStampaWord_Click
Dim MiaTabella
Dim RsStd As DAO.Recordset
Dim sSQL As String
Set oApp = CreateObject("Word.Application")
'..... renderò invisibile a test effettuati
oApp.Visible = True
'--------------- si comincia a pilotare
prendiDot "IlMioModello.dot" 'carica il modello in oApp
'============================================
'----------------- vedremo di limare un pò
sSQL = "select * from T_OFFERTA where id_off =" & IDOfferta
Set RsStd = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset)
If Not RsStd.EOF Then
Select Case Lingua
Case "ITA"
strModTesta = RsStd("Testata_Ita")
strModCondVend = RsStd("Cond_Vend_Ita")
strModCompStd = RsStd("Compon_Ita")
strModCondComm = RsStd("Cond_Comm_Ita")
Case "ING"
strModTesta = RsStd("Testata_Ing")
strModCondVend = RsStd("Cond_Vend_Ing")
strModCompStd = RsStd("ComponetIng")
strModCondComm = RsStd("Cond_Comm_Ing")
Case Else
Stop
End Select
Else
Stop
End If
'-----------------
inserisci 'riempio i bookmarks fissi (intestazione ...)
'------------------
'creo la tabella per ogni articolo
'mi porto in fondo
oApp.ActiveDocument.Bookmarks("ElencoArticoli").Select
'creo il recordset e per ogni voce looppo con tabella e costo
'----i campi in chiaro si riferiscono alla maschera che ho aperta in
quel momento
'---- con la commessa già selezionata e visibile
sSQL = "SELECT T_ComposOfferta.IDOfferta, T_ComposOfferta.Ordine,
T_Anagrafica.Codmac, T_Anagrafica.Nomemac, T_ComposOfferta.DescrizioneBreve,
T_ComposOfferta.DescrizioneEstesa, T_Anagrafica.Descmac,
T_Anagrafica.Notemac, T_ComposOfferta.Prezzo, T_ComposOfferta.Optional,
Round(([prezzo]/(100- " & [Sconto] & _
"))/(100-" & [Provvigione] & ")*10000,0) AS Prezzo0,
T_ComposOfferta.Pos, T_Offerta.Testata_Ita, IIf([prezzo0] Mod
10=0,[prezzo0],Int([prezzo0]/10+1)*10) AS Prezzo1 " & _
"FROM (T_ComposOfferta INNER JOIN T_Anagrafica ON
T_ComposOfferta.Articolo = T_Anagrafica.Id) INNER JOIN T_Offerta ON
T_ComposOfferta.IDOfferta = T_Offerta.ID_Off " & _
"WHERE (((T_ComposOfferta.IDOfferta) Like '" & [IDOfferta] & "')
AND ((T_Anagrafica.Codmac) Not Like 'zucm*')) " & _
"ORDER BY T_ComposOfferta.Ordine;"
Set RsStd = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset)
RsStd.MoveFirst
'... per ogni record del recordset
Do
'creo le prime due celle
Set MiaTabella =
oApp.ActiveDocument.Tables.Add(Range:=oApp.Selection.Range, NumRows:=1,
NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed)
For Each cella In MiaTabella.Columns
totale = totale + cella.Width
Next cella
totale = totale / 28.35
larghezzaPrimaCella = 2.5
'aggiusto larghezza celle
With MiaTabella
.Cell(1, 1).Range.Bold = True
.Cell(1, 1).Range.Font.Size = 8
LevaBordi (MiaTabella.Cell(1, 1))
.Cell(1, 1).SetWidth _
ColumnWidth:=CentimetersToPoints(larghezzaPrimaCella),
_
RulerStyle:=wdAdjustNone
.Cell(1, 1) = RsStd!Codmac
'--- - - - -
.Cell(1, 2).Range.Bold = False
.Cell(1, 2).Range.Font.Size = 10
LevaBordi (MiaTabella.Cell(1, 2))
.Cell(1, 2).SetWidth _
ColumnWidth:=CentimetersToPoints(Int(totale -
larghezzaPrimaCella)), _
RulerStyle:=wdAdjustNone
.Cell(1, 2) = RsStd!DescrizioneEstesa
'--- queste servono a qualcosa?
If .Style <> "Griglia tabella" Then
.Style = "Griglia tabella"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
'--- esco dalla tabella e vado in fondo
oApp.Selection.EndKey Unit:=wdStory
'---- inserisco i tabulatori
oApp.Selection.ParagraphFormat.TabStops.Add
Position:=CentimetersToPoints(9.84) _
, Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
oApp.Selection.ParagraphFormat.TabStops.Add
Position:=CentimetersToPoints(17.5 _
), Alignment:=wdAlignTabDecimal, Leader:=wdTabLeaderSpaces
oApp.Selection.TypeText _
Text:=vbTab & "Prezzo Cad ......." & _
vbTab & Format(RsStd!Prezzo1, "##,##0.00")
oApp.Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
oApp.Selection.Font.Bold = True
'------ riga vuota
oApp.Selection.EndKey Unit:=wdStory
'----- traccio una riga di separazione
With oApp.Selection
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
End With
oApp.Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
'--- vado a capo
oApp.Selection.EndKey Unit:=wdStory
Set MiaTabella = Nothing
RsStd.MoveNext
Loop While Not RsStd.EOF
Set oApp = Nothing
'============================================
Exit_bStampaWord_Click:
Exit Sub
Err_bStampaWord_Click:
MsgBox Err.Description
Stop
Resume Next
Resume Exit_bStampaWord_Click
End Sub
--------------------------
Sub inserisci()
'------------- testata
AggiornaBmk _
"testaOffertaNr", NROfferta '"@@@@"
AggiornaBmk _
"testaLayoutNr", Layout2 '"@@@@"
AggiornaBmk _
"testaData", Date '"@@@@"
'------------- spettabile
AggiornaBmk _
"spettCliente", Cliente '"@@@@"
AggiornaBmk _
"spettIndirizzo", Indirizzo1 '"@@@@"
AggiornaBmk _
"spettCAP", Cap '"@@@@"
AggiornaBmk _
"spettCitta", Citta '"@@@@"
AggiornaBmk _
"spettStato", Stato '"@@@@"
'------------- datiDiprogetto
AggiornaBmk _
"datiDiProgetto", strModTesta
End Sub
-------------------
Sub AggiornaBmk(nomeBook As String, stesto As String)
'Dim bkm As Bookmark, rngBmk As Range
Dim bkm As Variant, rngBmk As Variant
Dim nameBmk As String
Set bkm = oApp.ActiveDocument.Bookmarks(nomeBook)
Set rngBmk = bkm.Range
nameBmk = bkm.Name
rngBmk.Text = stesto
'oApp.ActiveDocument.Bookmarks.Add nameBmk, rngBmk
End Sub
---------------------
Sub prendiDot(sFile As String)
'
' prendiDot Macro
' Macro registrata il 11/8/2006 da ivan
'
'Stop
oApp.Documents.Add Template:= _
"C:\id Ivan\" & sFile _
, NewTemplate:=False, DocumentType:=0
'oApp.Documents.Add Template:= _
"C:\Documents and Settings\HP_Administrator\Dati
applicazioni\Microsoft\Modelli\" & sFile _
, NewTemplate:=False, DocumentType:=0
End Sub
=================
capisco che il tutto sia un pò lunghino, ma il problema è all'inizio (su
Of2003) quando provo di inserire la prima cosa in oApp, errore e nella GUI
di Word non è ancora caricato nulla.
IvanDaBologna