Newsgroup: it.comp.lang.visual-basic
Titolo: VB6 ed Excel

Salve a tutti,
    ho la necessità di andare a creare un foglio Excel con il contenuto di
una MSHFlexGrid.Sapreste dirmi come fare?
Grazie.

 wrote in message
9r35if$ht8$1...@fe2.cs.interbusiness.it...

io ho fatto così (non ho voglia di cancellare le righe che non ti
interessano, pensaci te) ciao
Dim Colonna As Single
Dim Riga As Single
Dim nck As Single
On Error GoTo EE_cmd_exportXLS_Click
CommonDialog_file.Flags = cdlOFNHideReadOnly '+ cdlOFNOverwritePrompt
CommonDialog_file.CancelError = True
CommonDialog_file.InitDir = DirectoryCorr
CommonDialog_file.FileName = frm_articoli.Caption & " del " & Day(Now) & "_"
& Month(Now) & "_" & Year(Now)
CommonDialog_file.DefaultExt = "xls"
CommonDialog_file.Filter = "*.xls"
CommonDialog_file.ShowSave
Set objExcel = CreateObject("excel.sheet")
'Screen.MousePointer = 11
data_articoli.Recordset.MoveLast
frm_progres.ProgressBar1.Max = data_articoli.Recordset.RecordCount
data_articoli.Recordset.MoveFirst
frm_progres.Top = frm_articoli.Height / 2 - frm_progres.Height / 2
frm_progres.Left = frm_articoli.Width / 2 - frm_progres.Width / 2
frm_progres.Show
blocco = True
With objExcel.Sheets(1)
    Colonna = 1
    Riga = 1
    .Cells(Riga, Colonna).Value = utente.ragioneSociale
    Riga = Riga + 1
    .Cells(Riga, Colonna).Value = utente.indirizzo
    Riga = Riga + 1
    .Cells(Riga, Colonna).Value = frm_articoli.Caption
    Riga = Riga + 1
    For nck = 1 To 16
        If chk_campi(nck).Value = 1 Then
            .Cells(Riga, Colonna).Value = chk_campi(nck).Caption
            Colonna = Colonna + 1
        End If
    Next nck
    data_articoli.Recordset.MoveFirst
        Do Until data_articoli.Recordset.EOF
        DoEvents
        If break = True Then
            break = False
            Screen.MousePointer = 0
            Unload frm_progres
            Exit Sub
        End If
        frm_progres.ProgressBar1.Value =
data_articoli.Recordset.AbsolutePosition
        Riga = Riga + 1
        Colonna = 1
        If chk_campi(1).Value = 1 Then
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("codice")
            Colonna = Colonna + 1
        End If
        If chk_campi(2).Value = 1 Then
            .Cells(Riga, Colonna).Value =
data_articoli.Recordset(nomeCampo(2))
            Colonna = Colonna + 1
        End If
        If chk_campi(3).Value = 1 Then
            .Cells(Riga, Colonna).Value =
data_articoli.Recordset(nomeCampo(3))
            Colonna = Colonna + 1
        End If
        If chk_campi(4).Value = 1 Then
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("Stato")
            Colonna = Colonna + 1
        End If
        If chk_campi(5).Value = 1 Then
            .Cells(Riga, Colonna).Value =
CVDate(data_articoli.Recordset("[Data entrata]"))
            Colonna = Colonna + 1
        End If
        If chk_campi(6).Value = 1 Then
            .Cells(Riga, Colonna).NumberFormat = "###,###,###"
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("[Costo
acquisto 1]") 'Format(data_articoli.Recordset("[Costo acquisto 1]"),
"###,###,###")
            Colonna = Colonna + 1
       End If
        If chk_campi(7).Value = 1 Then
            .Cells(Riga, Colonna).NumberFormat = "###,###,###"
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("[Costo
acquisto 2]") 'Format(data_articoli.Recordset("[Costo acquisto 2]"),
"###,###,###")
            Colonna = Colonna + 1
        End If
        If chk_campi(8).Value = 1 Then
            .Cells(Riga, Colonna).NumberFormat = "###,###,###"
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("[Listino
1]") 'Format(data_articoli.Recordset("[Listino 1]"), "###,###,###")
            Colonna = Colonna + 1
        End If
        If chk_campi(9).Value = 1 Then
            .Cells(Riga, Colonna).NumberFormat = "###,###,###"
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("[Listino
2]") 'Format(data_articoli.Recordset("[Listino 2]"), "###,###,###")
            Colonna = Colonna + 1
        End If
        If chk_campi(10).Value = 1 Then
            .Cells(Riga, Colonna).NumberFormat = "###,###,###"
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("[Prezzo
vendita 1]") 'Format(data_articoli.Recordset("[Prezzo vendita 1]"),
"###,###,###")
            Colonna = Colonna + 1
        End If
        If chk_campi(11).Value = 1 Then
            .Cells(Riga, Colonna).NumberFormat = "###,###,###"
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("[Prezzo
vendita 2]") 'Format(data_articoli.Recordset("[Prezzo vendita 2]"),
"###,###,###")
            Colonna = Colonna + 1
        End If
        If chk_campi(12).Value = 1 Then
            .Cells(Riga, Colonna).Value = data_articoli.Recordset("Flag")
            Colonna = Colonna + 1
        End If
        If chk_campi(13).Value = 1 Then
            .Cells(Riga, Colonna).Value =
data_articoli.Recordset("Giacenza")
            Colonna = Colonna + 1
        End If
        If chk_campi(14).Value = 1 Then
            .Cells(Riga, Colonna).Value =
data_articoli.Recordset(nomeCampo(14))
            Colonna = Colonna + 1
        End If
        If chk_campi(15).Value = 1 Then
            .Cells(Riga, Colonna).Value =
data_articoli.Recordset(nomeCampo(15))
            Colonna = Colonna + 1
        End If
        If chk_campi(16).Value = 1 Then
            .Cells(Riga, Colonna).Value =
CVDate(data_articoli.Recordset("Data uscita"))
            Colonna = Colonna + 1
        End If
        data_articoli.Recordset.MoveNext
    Loop
End With
blocco = False
Unload frm_progres
objExcel.SaveAs CommonDialog_file.FileName
'Screen.MousePointer = 0
res = MsgBox("Si desidera visualizzare adesso il foglio di calcolo Excel: "
& frm_articoli.Caption & " del " & Day(Now) & "_" & Month(Now) & "_" &
Year(Now) & ".xls?", vbYesNo + vbQuestion, Me.Caption)
If res = vbNo Then
    objExcel.Application.QUIT
    Set objExcel = Nothing
Else
    objExcel.Application.Visible = True
End If
Exit Sub
EE_cmd_exportXLS_Click:
np = "cmd_exportXLS_Click"
nf = Me.Name
Select Case Err
    Case -
2147417848
, -
2147023174
        'Screen.MousePointer = 0
        Unload frm_progres
        blocco = False
        MsgBox "Errore di automazione OLE: il foglio di lavoro potrebbe
essere già aperto. Chiudelo e riprovare", vbCritical, Me.Caption
    Case 32755
        'Screen.MousePointer = 0
        blocco = False
        Exit Sub
    Case 1004
        Resume Next
    Case 94
        Resume Next
    'Case .... '(specificare codici di errori gestiti)
        'ng = 0
        'Call ege
    Case Else
        'Screen.MousePointer = 0
        Unload frm_progres
        blocco = False
        ng = 1
        Call ege
        Exit Sub
End Select