estratto conto

Attribute VB_Name = "estratto_conto"

'

Option Explicit

'

' vba - excel

' riferimenti: Microsoft Word Object library

' estratto conto su tabella WOrd

' scorre il foglio di Excel, e anche in presenza di un cliente con pià righe concomitanti

' crea un unico documento word.

' Nel documento Word sono presenti due tabelle:

' 1 - dati clienti

' 2 - dettaglio documenti del cliente

'

Public Const modelloword = "C:\circolarizzazione_crediti\ClientiEstrattoConto.dot"

Public Const cartellasalvataggio = "C:\circolarizzazione_crediti\EC\"

'

Dim appWD As Word.Application

Dim nomedoc, tabtesta, tabdettaglio, docrighe

Dim docaperto

'

Sub vaiwordn(nomedocumento) ' crea nuovo documeto Word

Set appWD = CreateObject("Word.Application")

appWD.Visible = True

'

With appWD

.Documents.Add Template:=nomedocumento, NewTemplate:=False, DocumentType:=0

nomedoc = .ActiveDocument.Name

.Activate

End With

'

appWD.Documents(nomedoc).Activate

'

' setta il riferimento al documento

Set tabtesta = appWD.Documents(nomedoc).Tables(1) ' dati del cliente (ragione sociale, indirizzo etc.

Set tabdettaglio = appWD.Documents(nomedoc).Tables(2) ' tabella dettaglio del credito

'

docaperto = 1

'

End Sub

'

Sub salvadoc(salvaconnome) ' salva documento

'

appWD.ActiveDocument.SaveAs salvaconnome

' applicazione visibile

appWD.Visible = True

' a tutto shermo

appWD.WindowState = wdWindowStateMaximize

' attivato

appWD.Application.Activate

'

appWD.ActiveDocument.Close

appWD.Quit



Set appWD = Nothing

docaperto = 0 ' flag

End Sub

'

Sub PreparaEstrattoConto()

Dim quanterighe, contarighe, foglio, conto, contoprecedente, colonnai, docreati

Dim nomefoglio As String, riga, nomedocumento As String, salvaconnome As String, importo, totale

nomefoglio = ActiveSheet.Name

Set foglio = Sheets(ActiveSheet.Name)

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

nomedocumento = modelloword ' utilizza un modello di Word

colonnai = "C" ' colonna contenete il campo di controllo - tipo codice cliente/partita iva

'

contoprecedente = 0

docreati = 0

totale = 0 ' totale delle partite del cliente

importo = 0

'

contarighe = 2 ' parte dalla seconda riga del foglio

While contarighe <= quanterighe

conto = Trim(foglio.Cells(contarighe, colonnai).Value)

If Len(conto) > 0 Then ' verifica che la cella non sia vuota

If conto <> contoprecedente Then ' verifica il cambio del codice cliente/partita iva

If docreati > 0 Then ' salva il documento con il valore della cella chiave

salvaconnome = cartellasalvataggio & contoprecedente

Call salvadoc(salvaconnome)

End If

Call vaiwordn(nomedocumento)

docreati = docreati + 1

tabtesta.Cell(Row:=1, Column:=2).Range.InsertAfter Text:=foglio.Cells(contarighe, "D").Value ' ragione sociale

tabtesta.Cell(Row:=2, Column:=2).Range.InsertAfter Text:=foglio.Cells(contarighe, "R").Value ' indirizzo

tabtesta.Cell(Row:=3, Column:=2).Range.InsertAfter Text:=foglio.Cells(contarighe, "T").Value ' città

contoprecedente = conto

End If

docrighe = tabdettaglio.Rows.Count ' conteggio righe della tabella dettaglio

'

tabdettaglio.Cell(Row:=docrighe, Column:=1).Select

tabdettaglio.Rows.Add ' aggiunge righe alla tabella Word contente il dettaglio dei dati



tabdettaglio.Cell(Row:=docrighe, Column:=1).Range.InsertAfter Text:=foglio.Cells(contarighe, "B").Value ' data scadenza

tabdettaglio.Cell(Row:=docrighe, Column:=2).Range.InsertAfter Text:=foglio.Cells(contarighe, "F").Value ' causale scadenza

tabdettaglio.Cell(Row:=docrighe, Column:=3).Range.InsertAfter Text:=foglio.Cells(contarighe, "K").Value ' totale documento

tabdettaglio.Cell(Row:=docrighe, Column:=4).Range.InsertAfter Text:=foglio.Cells(contarighe, "L").Value ' importo scadenza

tabdettaglio.Cell(Row:=docrighe, Column:=5).Range.InsertAfter Text:=foglio.Cells(contarighe, "M").Value ' numero documento

tabdettaglio.Cell(Row:=docrighe, Column:=6).Range.InsertAfter Text:=foglio.Cells(contarighe, "G").Value ' serie documento

tabdettaglio.Cell(Row:=docrighe, Column:=7).Range.InsertAfter Text:=foglio.Cells(contarighe, "A").Value ' data documento

docrighe = docrighe + 1

'

End If

contarighe = contarighe + 1

Wend

'

'

If docaperto = 1 Then ' contatore di documento ancora aperto

salvaconnome = cartellasalvataggio & contoprecedente

Call salvadoc(salvaconnome)

End If

'

'Set appWD = Nothing

'appWD.ActiveDocument.Save

'appWD.Quit

'

End Sub

'