Newsgroup: it.comp.appl.access
Titolo: Da Access a Excel

Buon anno a tutti
C'č la possibilitą con un solo clic di selezzionare, copiare, aprire excel e
incollare.
Grazie Pino

 Grazie Pino
Sarebbe interessante sapere da dove vuoi partire ... qui di seguito il  
codice per estrarre i dati dalla maschera V10_Offerte e anche per  
formattare il foglio di lavoro risultalte in Excel:
Private Sub cmdExcel_Click()
     Dim dbLocale As Database
     Dim snpMovimenti As DAO.Recordset
     Dim wbkNuovo As Excel.Workbook, wksNuovo As Excel.Worksheet
     Dim rngCorrente As Excel.Range
     Dim appExcel As Excel.Application
     Dim strParm As String
     Set dbLocale = CurrentDb()
     DoCmd.OpenForm "V10_Offerte", acNormal, ,  
"IDOfferta=Forms!V00_Gare!IDOfferta", acFormReadOnly
     Set snpMovimenti = Forms![V10_Offerte].RecordsetClone
     Set appExcel = New Excel.Application
     Set wbkNuovo = appExcel.Workbooks.Add
     Set wksNuovo = wbkNuovo.Worksheets.Add
     appExcel.Visible = True
     Set rngCorrente = wksNuovo.Range(wksNuovo.Cells(2, 1),  
wksNuovo.Cells(2 + snpMovimenti.RecordCount, 3))
     rngCorrente.CopyFromRecordset snpMovimenti
     With wksNuovo
          .Columns("S").Delete
          .Columns("R").Delete
          .Columns("Q").Delete
          .Columns("P").Delete
          .Columns("O").Delete
          .Columns("L").Delete
          .Columns("J").Delete
          .Columns("A").Delete
          .Cells(1, 1).Value = "Pos."
          .Cells(1, 2).Value = "Codice"
          .Cells(1, 3).Value = "Descrizione"
          .Cells(1, 4).Value = "Confezione"
          .Cells(1, 5).Value = "Taglio"
          .Cells(1, 6).Value = "Quantità"
          .Cells(1, 7).Value = "Listino"
          .Cells(1, 8).Value = "Listino unitario"
          .Cells(1, 9).Value = "Sconto applicato"
          .Cells(1, 10).Value = "Prezzo netto conf."
          .Cells(1, 11).Value = "Quant. richiesta"
          .Cells(1, 12).Value = "Conf. richieste"
          .Cells(1, 13).Value = "PrezzoUnit"
          .Cells(1, 14).Value = "Prezzo netto tot."
          .Cells(2, 8).Formula = "=G2/(D2*E2)"
          .Cells(2, 9).Formula = "=1-(J2/G2)"
          .Cells(2, 12).Formula = "=Roundup(K2/(D2*E2),0)"
          .Cells(2, 13).Formula = "=J2/(D2*E2)"
          .Cells(2, 14).Formula = "=J2*L2"
          .Range(wksNuovo.Cells(2, 8), wksNuovo.Cells(2, 9)).Copy
          .Range(wksNuovo.Cells(3, 8), wksNuovo.Cells(3  
+ (snpMovimenti.RecordCount - 2), 9)).PasteSpecial
          .Range(wksNuovo.Cells(2, 9), wksNuovo.Cells(2  
+ (snpMovimenti.RecordCount - 1), 9)).Copy
          .Range(wksNuovo.Cells(2, 9), wksNuovo.Cells(2  
+ (snpMovimenti.RecordCount - 1), 9)).PasteSpecial Paste:=xlValues
          .Cells(2, 10).Formula = "=G2*(1-I2)"
          .Cells(2, 10).Copy
          .Range(wksNuovo.Cells(3, 10), wksNuovo.Cells(3  
+ (snpMovimenti.RecordCount - 2), 10)).PasteSpecial
          .Range(wksNuovo.Cells(2, 12), wksNuovo.Cells(2, 14)).Copy
          .Range(wksNuovo.Cells(3, 12), wksNuovo.Cells(3  
+ (snpMovimenti.RecordCount - 2), 12)).PasteSpecial
          .Rows("1").Font.Bold = True
          .Columns("A:N").HorizontalAlignment = xlCenter
          .Columns("A:N").EntireColumn.AutoFit
          .Columns("G").NumberFormat = "#,##0.00"
          .Columns("h").NumberFormat = "#,##0.00"
          .Columns("J").NumberFormat = "#,##0.00"
          .Columns("M:N").NumberFormat = "#,##0.00"
          .Columns("I").NumberFormat = "0.00%"
     End With
     snpMovimenti.Close
     DoCmd.Close
End Sub
-- 
Creato con il rivoluzionario client e-mail di Opera:  
http://www.opera.com/m2/

 ha scritto nel messaggio
news:opsjxo9to9ic237x@mattia...


 stampa.
- Da codice, quello che ti ho postato prima fa esattamente quello che ti  
serve, con gli adattamenti del caso ...
- Da menu Strumenti > Collegamenti di Office > Analizza con MS Excel.
Umberto
