codice:strSql = "SELECT c.Azienda, c.Indirizzo, c.Civico, c.Cap, c.Citta, c.Cognome, c.Nome, c.Partita_Iva, c.Codice_Fiscale, " & _ " d.Num_Documento, d.Data_Documento, d.Condizione_Documento, d.Tot_Imp_Forn_Euro, " & _ " d.Tot_Imponibile, d.Tot_Iva, d.Acconto, d.Tot_Documento, d.Stato_Fattura, d.Data_Riferimento, " & _ " d.Num_Rif_Fattura, d.Data_Rif_Fattura, d.Id_Attenzione " & _ " FROM Documento d, Cliente c" & _ " WHERE d.Id_Documento = " & vIdDocumento & _ " AND d.Tipo_Documento = '" & vTipoDoc & "' " & _ " AND d.Id_Cliente = c.Id_Cliente" Set RS = Db.Execute(strSql) If Trim(RS(0)) <> "-" Then If Len(Trim(RS(0))) > 40 Then xRangeInizio = "G" xRangeFine = "K" Else xRangeInizio = "H" xRangeFine = "K" End If Else vAnagrafica = Trim(RS(5)) & " " & Trim(RS(6)) If Len(vAnagrafica) > 40 Then xRangeInizio = "G" xRangeFine = "K" Else xRangeInizio = "H" xRangeFine = "K" End If End If X = X + 1 'Inizio Stampa sezione relativa al Cliente Set RG1 = WS.Range(xRangeInizio & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = "SPETT.LE" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 vPiva = Trim(RS(7)) vCodFisc = Trim(RS(8)) vNumDocumento = RS(9) vDataDocumento = Trim(RS(10)) vCondDocumento = Trim(RS(11)) vTotImpFornEuro = RS(12) vTotImponibile = RS(13) vTotIva = RS(14) vAcconto = RS(15) vTotDocumento = RS(16) vStatoFattura = Trim(RS(17)) vDataRiferimento = Trim(RS(18)) vNumRifFattura = Trim(RS(19)) vDataRifFattura = Trim(RS(20)) vIdAttenzioneDocumento = CInt(RS(21)) If vIdAttenzioneDocumento <> 0 Then 'Query sulla tabella dei nominativi (solo se valorizzato) strSql5 = "SELECT nom.Nome_Attenzione, nom.Cognome_Attenzione " & _ " FROM Nominativo_Attenzione nom " & _ " WHERE nom.Id_Attenzione = " & vIdAttenzioneDocumento Set RS2 = Db.Execute(strSql5) vCorteseAttenzioneDocumento = Trim(RS2(0)) & " " & Trim(RS2(1)) RS2.Close Set RS2 = Nothing Select Case (vTipoDoc) Case "F" vColore = 17 Case "P" vColore = 45 Case "NC" vColore = 13 End Select Set RG1 = WS.Range("A" & Y, "C" & Y) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &HFFFFFF RG1.Font.Bold = True RG1.Merge RG1.Value = "Cortese attenz. Sig./Sig.ra" WS.Range("A" & Y, "C" & Y).Interior.ColorIndex = vColore WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 RG1.BorderAround XlLineStyle.xlContinuous Y = Y + 1 Set RG1 = WS.Range("A" & Y, "C" & Y) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = vCorteseAttenzioneDocumento WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 RG1.BorderAround XlLineStyle.xlContinuous End If X = X + 1 If vTipoDoc = "NC" Then 'Inizio Sezione stampa riferimento alla Fattura 'Controllo se la Nota di Credito è legata ad una Fattura strSql3 = "SELECT Id_Fattura " & _ " FROM Fattura_NotaCredito " & _ " WHERE Id_NotaCredito = " & vIdDocumento Set RS2 = Db.Execute(strSql3) If Not RS2.EOF Then 'Se c'è il legame, recupero le informazioni dalla Fattura strSql4 = "SELECT Num_Documento, Data_Documento " & _ " FROM Documento " & _ " WHERE Tipo_Documento = 'F' " & _ " AND Id_Documento = " & RS2(0) Set RS3 = Db.Execute(strSql4) vStringaRiferimento = "Riferimento Fattura N° " & RS3(0) & " del " & RS3(1) RS3.Close Set RS3 = Nothing Else vStringaRiferimento = "Riferimento Fattura N° " & vNumRifFattura & " del " & vDataRifFattura End If RS2.Close Set RS2 = Nothing Set RG1 = WS.Range("G" & X_Rif, "K" & X_Rif) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = vStringaRiferimento WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 'Fine Sezione stampa riferimento alla Fattura End If If Trim(RS(0)) = "-" Then Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(5)) & " " & Trim(RS(6)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(1)) & ", " & Trim(RS(2)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(3)) & " " & Trim(RS(4)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 vConta = 1 Else If InStr(1, Trim(RS(0)), vbCrLf) <> 0 Then varArray = Split(Trim(RS(0)), vbCrLf) For Each varItem In varArray Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = varItem WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 vConta = vConta + 1 Next Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(1)) & ", " & Trim(RS(2)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(3)) & " " & Trim(RS(4)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 Else Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(0)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(1)) & ", " & Trim(RS(2)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 Set RG1 = WS.Range(xRangeInizio & X, xRangeFine & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(3)) & " " & Trim(RS(4)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 vConta = 1 End If End If RS.Close Set RS = Nothing 'Fine Stampa sezione relativa al Cliente 'Inizio Stampa sezione relativa al Congresso X = X + 2 Set RG1 = WS.Range("A" & X, "B" & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = "Nome Evento" WS.Range("A" & X, "B" & X).Interior.ColorIndex = 15 WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 RG1.BorderAround XlLineStyle.xlContinuous strSql = "SELECT Titolo_Congresso " & _ " FROM Documento d, Congresso c" & _ " WHERE d.Id_Documento = " & vIdDocumento & _ " AND d.Tipo_Documento = '" & vTipoDoc & "' " & _ " AND d.Id_Congresso = c.Id_Congresso" Set RS = Db.Execute(strSql) X = X + 1 'Se il nome del Congresso è maggiore di 80 caratteri, 'recupero solamente i primi 80 caratteri If Len(Trim(RS(0))) > 80 Then vCongresso = Trim(Mid(RS(0), 1, 80)) Else vCongresso = Trim(RS(0)) End If vCongressoDiviso = dividiStringa(Trim(RS(0)), 12) If InStr(1, vCongressoDiviso, vbCrLf) <> 0 Then varArray = Split(vCongressoDiviso, vbCrLf) For Each varItem In varArray Set RG1 = WS.Range("A" & X, "K" & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = varItem WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 RG1.BorderAround XlLineStyle.xlContinuous 'Setto la variabile a true vACapo = True X = X + 1 Next Else Set RG1 = WS.Range("A" & X, "K" & X) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Trim(RS(0)) WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 RG1.BorderAround XlLineStyle.xlContinuous 'Setto la variabile a false vACapo = False X = X + 1 End If RS.Close Set RS = Nothing 'Fine Stampa sezione relativa al Congresso
Rispondi quotando