Buonasera a Tutti,
piccolo problema, premetto di aver cercato in tutti gli Help possibili (penso!!!) ma senza risutato, ho scritto una function che mi crea dei files excel, prelevando solo i primi 40 record estratti secondo un criterio di ordinamento inserito nella select.
Il mo problema è questo:
dopo aver esportato i dati in un file ecel devo ordinarli secondo la colonna g, ci sto sbattendo la testa da un po di tempo e nulla.
Il codice l'ho mutuato facendo una macro da excel, ma come facilmente intuibile non funziona.
Chi mi da una mano? posto il codice per facilità.
Grazie in anticipo.
codice:Function X4511SS() Dim xlApp As Object Dim oWks As Object Dim mRst As DAO.Recordset Dim r As Integer 'On Error GoTo Handle_err Dim strSh As String Dim oshe As Object Dim X As Integer Dim giorno As Date Dim DT As Date Dim SS As String Dim CODA As String Dim DE_A As Variant Dim DEA As String CODA = 4511 DE_A = DLookup("[DA]", "TSS", "[CA] = 4511") DEA = DE_A giorno = DLookup("[datarif]", "CalcoloPdt") 'DT = DLookup("[pd]", "TSS") 'manc = DLookup("[ggf]", "CalcoloPdt") ' APRE SE ESISTE GIA' UN'OGGETTO EXCEL Set xlApp = CreateObject("Excel.Application") Set oWkb = xlApp.Workbooks.Add() oWkb.SaveAs CurrentProject.Path & "/_xls/4511TOP40PDSS_" & Format(giorno, "ddMMyyyy") & ".xls" ' Elimino i Fogli che Excel crea di DEFAULT For X = oWkb.Sheets.Count To 2 Step -1 oWkb.Sheets(X).Delete Next ' Alla fine rendo visibile EXCEL xlApp.Visible = True ' Assegno un nome al Foglio(Sheet) rimasto. oWkb.Sheets(1).Name = "PD_SS_TOP40" ' Scrivo l'intestazione iniziale oWkb.Sheets(1).Range("A2").Value = "XXXXXXXXXXXXXXXXXXXXXXXXXXX" oWkb.Sheets(1).Range("A1").Value = "xxxxxxxxxxxxxxxxx" " & CODA & " " & DEA oWkb.Sheets(1).Range("A3").Value = "Giorni Mancanti " & manc oWkb.Sheets(1).Range("g3").Value = "ESTRAZIONE DEL" oWkb.Sheets(1).Range("K3").Value = giorno oWkb.Sheets(1).Range("a4").Value = "COD" oWkb.Sheets(1).Range("b4").Value = "DENOMINAZIONE" oWkb.Sheets(1).Range("C4").Value = "NDG" oWkb.Sheets(1).Range("D4").Value = "INTESTAZIONE" oWkb.Sheets(1).Range("E4").Value = "SALDO" oWkb.Sheets(1).Range("F4").Value = "SCONF" oWkb.Sheets(1).Range("G4").Value = "%SCONF" oWkb.Sheets(1).Range("H4").Value = "GG" oWkb.Sheets(1).Range("I4").Value = "P/B" oWkb.Sheets(1).Range("J4").Value = "OrgDel" oWkb.Sheets(1).Range("k4").Value = "NOTE" oWkb.Sheets(1).Range("A1:K2").select 'Imposto il FONT in Grassetto a dimensiono a 12 le prime 4 righe e metto i bordi solo nelle righe oWkb.Sheets(1).ROWS("1:2").select xlApp.Application.Selection.Font.Bold = True xlApp.Application.Selection.Font.Size = 12 oWkb.Sheets(1).ROWS("3:4").select xlApp.Application.Selection.Font.Bold = True xlApp.Application.Selection.Font.Size = 10 oWkb.Sheets(1).Range("a5:k44").select xlApp.Application.Selection.borders(4).LineStyle = 2 'Size = 8 oWkb.Sheets(1).Range("i5:k44").select xlApp.Application.Selection.borders(1).LineStyle = 2 oWkb.Sheets(1).Range("a4:k4").select xlApp.Application.Selection.interior.colorindex = 15 oWkb.Sheets(1).ROWS("5:50").select xlApp.Application.Selection.Font.Size = 8 oWkb.Sheets(1).Range("e46").select xlApp.Application.Selection.Font.Bold = True oWkb.Sheets(1).Range("f46").select xlApp.Application.Selection.Font.Bold = True ' Seleziono la Cella A1 oWkb.Sheets(1).Range("a1").select 'Unisco le celle da a1 a K1 oWkb.Sheets(1).Range("A1:K1").select With Selection oWkb.Sheets(1).Range("A1:K1").MergeCells = True End With 'Unisco celle A2 K2 oWkb.Sheets(1).Range("A2:K2").select With Selection oWkb.Sheets(1).Range("A2:K2").MergeCells = True End With Const xlCenter = -4108 'Unisco celle A2 K2 oWkb.Sheets(1).Range("A3:B3").select With Selection oWkb.Sheets(1).Range("A3:B3").MergeCells = True End With 'Const xlCenter = -4108 With oWkb.Sheets(1) .select .Range("A1:J4").select xlApp.Selection.HorizontalAlignment = xlCenter End With 'Unisco celle da g3 a J3 oWkb.Sheets(1).Range("g3:j3").select With Selection oWkb.Sheets(1).Range("g3:j3").MergeCells = True End With oWkb.Sheets(1).ColumnS("a:k").EntireColumn.AutoFit oWkb.Sheets(1).ColumnS("b").ColumnWidth = 19 oWkb.Sheets(1).ColumnS("C").ColumnWidth = 8 oWkb.Sheets(1).ColumnS("G").Style = "Percent" oWkb.Sheets(1).ColumnS("G").NumberFormat = "0.00%" oWkb.Sheets(1).ColumnS("e").NumberFormat = "#,##0" oWkb.Sheets(1).ColumnS("e").ColumnWidth = 9 oWkb.Sheets(1).ColumnS("f").NumberFormat = "#,##0" oWkb.Sheets(1).ColumnS("f").ColumnWidth = 9 oWkb.Sheets(1).ColumnS("d").ColumnWidth = 35 oWkb.Sheets(1).ColumnS("k").ColumnWidth = 27 oWkb.Sheets(1).Range("5:44").RowHeight = 12 Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 1) = mRst.Fields(2) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 2) = mRst.Fields(3) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 3) = mRst.Fields(4) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 4) = mRst.Fields(5) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 5) = mRst.Fields(6) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 6) = mRst.Fields(7) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 7) = mRst.Fields(8) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop Set mRst = DBEngine(0)(0).OpenRecordset("Select top 40 * from TSS where [ca]=4511 order by [saldo] desc") ' apre tabella access mRst.MoveFirst r = 1 Do Until mRst.EOF oWkb.Worksheets("PD_SS_TOP40").cells(r + 4, 8) = mRst.Fields(9) ' scrive a partire da A1 il primo campo della tbl access mRst.MoveNext r = r + 1 Loop mRst.Close Set mRst = Nothing ' Alla fine rendo visibile EXCEL xlApp.Visible = True ' Aggiungo Totali alle Colonne E ed F oWkb.Sheets(1).Range("e46").Value = "=SUM(e5:e44)" oWkb.Sheets(1).Range("f46").Value = "=SUM(f5:f44)" oWkb.Sheets(1).Range("E46").select xlApp.Application.Selection.interior.colorindex = 15 oWkb.Sheets(1).Range("F46").select xlApp.Application.Selection.interior.colorindex = 15 ' Seleziono la Cella A1 oWkb.Sheets(1).Range("a1").select [COLOR=red] 'ORDINO I DATI NEL FILE EXCEL oWkb.Worksheets(1).Range("a5:k44").select with selection.Sort.Key1 = ("G5"), Order1.xlDescending, Header.xlGuess ,OrderCustom = 1, MatchCase = False, Orientation = xlTopToBottom, DataOption1 = xlSortNormal [/COLOR=red] 'Setto l'area di stampa oWkb.Sheets(1).Range("A1:K46").select oWkb.Sheets(1).Range("K46").Activate oWkb.Sheets(1).PageSetup.PrintArea = "$A$1:$K$46" 'oWkb.Sheets(1).PageSetup oWkb.Sheets(1).PageSetup.LeftHeader = "" oWkb.Sheets(1).PageSetup.CenterHeader = "" oWkb.Sheets(1).PageSetup.RightHeader = "" oWkb.Sheets(1).PageSetup.LeftFooter = "" oWkb.Sheets(1).PageSetup.CenterFooter = "" oWkb.Sheets(1).PageSetup.RightFooter = "" oWkb.Sheets(1).PageSetup.LeftMargin = xlApp.Application.InchesToPoints(0) oWkb.Sheets(1).PageSetup.RightMargin = xlApp.Application.InchesToPoints(0) oWkb.Sheets(1).PageSetup.TopMargin = xlApp.Application.InchesToPoints(0) oWkb.Sheets(1).PageSetup.BottomMargin = xlApp.Application.InchesToPoints(0) oWkb.Sheets(1).PageSetup.HeaderMargin = xlApp.Application.InchesToPoints(0) oWkb.Sheets(1).PageSetup.FooterMargin = xlApp.Application.InchesToPoints(0) '.PrintHeadings = False '.PrintGridlines = False ' .PrintComments = xlPrintNoComments oWkb.Sheets(1).PageSetup.CenterHorizontally = True oWkb.Sheets(1).PageSetup.CenterVertically = True 'oWkb.Sheets(1).PageSetup.PaperSize = xlPaperA4 oWkb.Sheets(1).PageSetup.FirstPageNumber = xlAutomatic 'oWkb.Sheets(1).PageSetup.Order = xlDownThenOver 'oWkb.Sheets(1).PageSetup.BlackAndWhite = False oWkb.Sheets(1).PageSetup.Zoom = False oWkb.Sheets(1).PageSetup.Draft = False oWkb.Sheets(1).PageSetup.FitToPagesWide = 1 oWkb.Sheets(1).PageSetup.FitToPagesTall = 1 oWkb.Sheets(1).PageSetup.PrintErrors = xlPrintErrorsDisplayed oWkb.Sheets(1).PageSetup.Orientation = 2 'ActiveWindow.SelectedSheets.PrintPreview ' Seleziono la Cella A1 oWkb.Sheets(1).Range("a1").select xlApp.ActiveWorkbook.Save xlApp.ActiveWorkbook.Close
Rispondi quotando