Spezzo il codice in più post, visto che non me lo fa inserire tutto:
codice:Dim AX As Excel.Application Dim WB As Workbook Dim WS As Worksheet Dim RG As Range Dim RG1 As Range Dim fFileName As String Dim strSql As String Dim strSql2 As String Dim strSql3 As String Dim strSql4 As String Dim strSql5 As String Dim vRigheDettaglio As Integer Dim vCicli As Integer Dim numero As Integer Dim vConta As Integer Dim X As Integer Dim Y As Integer Dim X_Rif As Integer Dim vIdAttenzioneDocumento As Integer Dim vCorteseAttenzioneDocumento As String Dim varArray As Variant Dim varItem As Variant Dim vPiva As String Dim vCodFisc As String Dim vCongresso As String Dim vNumDocumento As Integer Dim vDataDocumento As String Dim vCondDocumento As String Dim vTotImpFornEuro As Double Dim vTotImponibile As Double Dim vTotIva As Double Dim vAcconto As Double Dim vTotDocumento As Double Dim vStatoFattura As String Dim vDataRiferimento As String Dim vNumRifFattura As Integer Dim vDataRifFattura As String Dim vStringaRiferimento As String Dim i As Integer Dim i_iva As Integer Dim xRangeInizio As String Dim xRangeFine As String Dim vAnagrafica As String Dim vEtichetta As String Dim vColore As String Dim vColoreImporto Dim vDocumento As String Dim vNomeFile As String Dim contaDettaglio As Integer Dim X_cod As Integer Dim vTopQuery As Integer Dim vDescrizione As String Dim vCongressoDiviso As String Dim vACapo As Boolean Dim X_Cli As Integer On Error GoTo Error Me.MousePointer = vbHourglass Set AX = New Excel.Application Set WB = AX.Workbooks.Add Set WS = WB.Worksheets(1) With AX.Worksheets(1).PageSetup .LeftMargin = AX.InchesToPoints(0.39370078740157) .RightMargin = AX.InchesToPoints(0.39370078740157) .TopMargin = AX.InchesToPoints(0.39370078740157) .BottomMargin = AX.InchesToPoints(0.39370078740157) .HeaderMargin = AX.InchesToPoints(0.511811023622047) .FooterMargin = AX.InchesToPoints(0.511811023622047) End With vConta = 0 X = 1 X_Rif = 6 Y = 12 vACapo = False 'Ciclo principale per stampa su più pagine ove necessario For vCicli = 1 To vNumPagine If vCicli > 1 Then If vPiva = "" Then X = X + 9 Else Select Case (vConta) Case 1 If vACapo Then X = X + 11 '8 (da ripristinare) Else X = X + 12 '9 (da ripristinare) End If Case 2 If vACapo Then X = X + 10 '7 (da ripristinare) Else X = X + 11 '8 (da ripristinare) End If Case 3 If vACapo Then X = X + 9 '6 (da ripristinare) Else X = X + 10 '7 (da ripristinare) End If End Select X_Rif = X_Rif + 63 Y = Y + 62 vConta = 0 End If Select Case (vCicli) Case 2 vTopQuery = 54 '30 (da ripristinare) Case 3 vTopQuery = 81 '90 (da ripristinare) Case 4 vTopQuery = 108 '120 (da ripristinare) Case 5 vTopQuery = 135 '150 (da ripristinare) Case 6 vTopQuery = 162 '180 (da ripristinare) Case 7 vTopQuery = 189 '210 (da ripristinare) Case 8 vTopQuery = 216 '240 (da ripristinare) Case 9 vTopQuery = 243 '270 (da ripristinare) Case 10 vTopQuery = 270 '300 (da ripristinare) Case 11 ' (togliere in caso di ripristino) vTopQuery = 297 '300 (togliere in caso di ripristino) End Select End If 'Stampa del logo Set RG = WS.Range("A" & X, "C" & X) RG.Merge Select Case (vCicli) Case 1 WS.Range("A2:C2").Select With WS.Pictures.Insert(App.Path & "\FondoClicart.gif") .Left = WS.Range("A2").Left .Top = WS.Range("A2").Top End With Case 2 WS.Range("A65:C65").Select With WS.Pictures.Insert(App.Path & "\FondoClicart.gif") .Left = WS.Range("A65").Left .Top = WS.Range("A65").Top End With Case 3 WS.Range("A128:C128").Select With WS.Pictures.Insert(App.Path & "\FondoClicart.gif") .Left = WS.Range("A128").Left .Top = WS.Range("A128").Top End With Case 4 WS.Range("A191:C191").Select With WS.Pictures.Insert(App.Path & "\FondoClicart.gif") .Left = WS.Range("A191").Left .Top = WS.Range("A191").Top End With End Select WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 If Me.txtCodRif.Text <> "-" Then X_cod = X + 2 'Inizio stampa sezione Cod. Rif. (solo se valorizzato) Set RG1 = WS.Range("I" & X_cod) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = "Cod. Rif.:" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 Set RG1 = WS.Range("J" & X_cod, "K" & X_cod) RG1.Font.Name = "Arial" RG1.Font.Size = 10 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = Me.txtCodRif.Text WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 'Fine stampa sezione Cod. Rif. (solo se valorizzato) End If X = X + 6 X_Cli = X - 1 '1 Riga - prima parte in grassetto Set RG1 = WS.Range("A" & X_Cli, "B" & X_Cli) RG1.Font.Name = "Arial" RG1.Font.Size = 8 RG1.Font.Color = &H800000 RG1.Font.Bold = True RG1.Merge RG1.Value = "di G. La Rosa & C. sas" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 '1 Riga - seconda parte senza grassetto Set RG1 = WS.Range("C" & X_Cli, "E" & X_Cli) RG1.Font.Name = "Arial" RG1.Font.Size = 8 RG1.Font.Color = &H800000 RG1.Merge RG1.Value = "Via Aiace, 4 - 90151 Palermo" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 X_Cli = X_Cli + 1 '2 Riga Set RG1 = WS.Range("A" & X_Cli, "C" & X_Cli) RG1.Font.Name = "Arial" RG1.Font.Size = 8 RG1.Font.Color = &H800000 RG1.Merge RG1.Value = "Tel./Fax: 091.453082 - Cell. 389 5504989" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 X_Cli = X_Cli + 1 '3 Riga Set RG1 = WS.Range("A" & X_Cli, "D" & X_Cli) RG1.Font.Name = "Arial" RG1.Font.Size = 8 RG1.Font.Color = &H800000 RG1.Merge RG1.Value = "P.Iva: 05170710825 - C.F.: LRSGNN60H13G273H" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75 X = X + 1 X_Cli = X_Cli + 1 '4 Riga Set RG1 = WS.Range("A" & X_Cli, "D" & X_Cli) RG1.Font.Name = "Arial" RG1.Font.Size = 8 RG1.Font.Color = &H800000 RG1.Merge RG1.Value = "Mail: info@clic-art.it | Web: www.clic-art.it" WS.StandardWidth = 8 WS.Cells.RowHeight = 12.75
Rispondi quotando