Newsgroup: it.comp.lang.visual-basic
Titolo: esportazione su Excel da divetar vecchi...

Salve......ho la necessita' di esportare dei dati da un database (oracle) su
un foglio excel.....
il problema è che spesso sono sono 12.000 righe....moltipilcato per uan 30
di colonne è una tragedia....
c'è un modo per velocizzare quest'operzione?.....
premetto che utilizzo questo codice....:
Grazie Ale
Private Sub CARICA_Excel()
Dim obAppE As Object
Dim obfLavoro As Object
Dim blnEsec As Boolean
Dim i, j As Integer
Dim ofn As OPENFILENAME
Dim a
   Me.MousePointer = 13
    rs.MoveFirst
   'frmPadre.Sbar1.Panels(3).Text = "Estrazione in Excel in corso...."
   On Error Resume Next
   Set obAppE = GetObject(, "excel.Application")
   If Err.Number <> 0 Then
      Set obAppE = CreateObject("excel.Application")
      blnEsec = False
   Else
      blnEsec = True
   End If
   obAppE.Workbooks.Add
   obAppE.FixedDecimal = True
   Set obfLavoro = obAppE.ActiveSheet
   i = 1
   obfLavoro.Cells(i, 1).Value = "Ente"
   obfLavoro.Cells(i, 2).Value = "Cognome"
   obfLavoro.Cells(i, 3).Value = "Nome"
   obfLavoro.Cells(i, 4).Value = "Codice Fiscale"
   obfLavoro.Cells(i, 5).Value = "Comune di Nascita"
   obfLavoro.Cells(i, 6).Value = "Data di Nascita"
   obfLavoro.Cells(i, 7).Value = "Via Fiscale"
   obfLavoro.Cells(i, 8).Value = "Località Fiscale"
   obfLavoro.Cells(i, 9).Value = "Comune Fiscale"
   obfLavoro.Cells(i, 10).Value = "C.A.P. Fiscale"
   obfLavoro.Cells(i, 11).Value = "Esercizio"
   obfLavoro.Cells(i, 12).Value = "Mandato"
   obfLavoro.Cells(i, 13).Value = "Data Mandato"
   obfLavoro.Cells(i, 14).Value = "Tipo Ritenuta"
   obfLavoro.Cells(i, 15).Value = "Num. Doc. di Spesa"
   obfLavoro.Cells(i, 16).Value = "Num. Liquidazione"
   obfLavoro.Cells(i, 17).Value = "Descrizione Tipo Ritenuta"
   obfLavoro.Cells(i, 18).Value = "Imponibile"
   obfLavoro.Cells(i, 19).Value = "Imposta"
   'obfLavoro.Cells(i, 8).Font.Bold = True
   obfLavoro.Range("A1:S1").Font.Bold = True
   obfLavoro.Range("A1:S1").Orientation = 25
   obfLavoro.Range("A1:S1").Font.Color = RGB(0, 0, 144)
   i = 1
   Do While rs.EOF = False
       obfLavoro.Cells(i + 2, 1) = rs.Fields("Ente")
       obfLavoro.Cells(i + 2, 2) = rs.Fields("Cognome")
       obfLavoro.Cells(i + 2, 3) = rs.Fields("Nome")
       obfLavoro.Cells(i + 2, 4) = rs.Fields("Cod_fis")
       obfLavoro.Cells(i + 2, 5) = rs.Fields("Com_Nascita")
       obfLavoro.Cells(i + 2, 6) = rs.Fields("Data_nascita")
       obfLavoro.Cells(i + 2, 7) = rs.Fields("Via_fis")
       obfLavoro.Cells(i + 2, 8) = rs.Fields("Loc_fis")
       obfLavoro.Cells(i + 2, 9) = rs.Fields("Com_fis")
       obfLavoro.Cells(i + 2, 10) = rs.Fields("Cap_fis")
       obfLavoro.Cells(i + 2, 11) = rs.Fields("Esercizio")
       obfLavoro.Cells(i + 2, 12) = rs.Fields("Mandato")
       obfLavoro.Cells(i + 2, 13) = rs.Fields("Data_mandato")
       obfLavoro.Cells(i + 2, 14) = rs.Fields("tipo_ritenuta")
       obfLavoro.Cells(i + 2, 15) = rs.Fields("doc_spe")
       obfLavoro.Cells(i + 2, 16) = rs.Fields("liq")
       obfLavoro.Cells(i + 2, 17) = rs.Fields("tipo_rit")
       obfLavoro.Cells(i + 2, 18) = rs.Fields("imponibile")
       obfLavoro.Cells(i + 2, 19) = rs.Fields("imposta")
       obfLavoro.Cells(i + 2, 18) = IIf(rs.Fields("imponibile") = "0", "0",
Format(rs.Fields("imponibile"), "###########0"))
       obfLavoro.Cells(i + 2, 19) = IIf(rs.Fields("imposta") = "0", "0",
Format(rs.Fields("imposta"), "###########0"))
       i = i + 1
       rs.MoveNext
   Loop
   obfLavoro.Columns("R:S").NumberFormat = "###,###,###,##0"
   obfLavoro.Columns("A:S").EntireColumn.AutoFit
   obfLavoro.Range("R:S").HorizontalAlignment = xlRight
   obfLavoro.Range("A:A").HorizontalAlignment = xlCenter
   obfLavoro.Range("F:F").HorizontalAlignment = xlCenter
   obfLavoro.Range("J:K").HorizontalAlignment = xlCenter
   obfLavoro.Range("M:N").HorizontalAlignment = xlCenter
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = Me.hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "File Excel (*.xls)" & Chr$(0) & "*.XLS" & Chr$(0)
    ofn.lpstrFile = Space$(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = "c:\"
    ofn.lpstrTitle = "Salva con nome"
    ofn.flags = 6
    ofn.lpstrDefExt = ".XLS"
    a = GetSaveFileName(ofn)
    If (a) Then
            obfLavoro.SaveAs Trim$(ofn.lpstrFile)
            obAppE.ActiveWorkbook.Close = False
            If Not (blnEsec) Then
                      obAppE.Quit
            End If
    Else
            obAppE.ActiveWorkbook.Saved = True
            obAppE.Quit
            Set obAppE = Nothing
    End If
   'frmPadre.Sbar1.Panels(3).Text = "Estrazione Excel terminata...."
   Me.MousePointer = 1
End Sub

Ci sono diverse soluzioni:
1)Disabilitare il ricalcolo automatico di excel, altrimenti ogni volta
che scrivi iun una cella parte il calcolo
2) Copiare i dati in memoria ed incollarli in un colpo solo su excel, i
dati vanno formattati opportunamente per essere rappresentati in formato
griglia
3) (Soluzione migliore) Scarica i dati i un file di testo che alla fine
del processo converti in excel.
	Lore.


>si ma come si fa??????
Quale soluzione intendi?
Sai diventa piuttosto complicato illustrarti tutte e tre le soluzioni.
Comunque per la scrittura su file di testo ti consiglio di vedere
l'help, cerca i comandi "open" e "write".
	Lore.

.....per disabilitare il calcolo automatico qual'è la funzione?
Set m_obOutput = GetObject("output.xls")
m_obOutput.application.calculation = -4135 ' disabilita il calcolo
m_obOutput.application.calculation = -4105 ' abilita il calcolo
m_obOutput.application.calculate ' forza il calcolo manuale
	Lore.