Newsgroup: it.comp.lang.visual-basic
Titolo: Come scrivere i dati su un foglio Excel con VB?

Ciao a tutti,
devo realizzare un'applicazione esterna ad Excel, la quale sia in grado di
scrivere un semplice file XLS (poche righe e colonne).
Come devo fare?
E' possibile?
Ringrazio tutti in anticipo.
Emiliano

 scrivere un semplice file XLS (poche righe e colonne).
dim f as integer
f = freefile
open [miopath][miofile] & ".xls" for output as #f
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
    print#f, dato1 & vbtab & dato2 & vbtab & dato3 'fino a che vuoi
close #f
esplora risorse, doppio click ed excel la apre incasellando i dati :)
bai
-> GbC|
www.gbcweb.com

 E' possibile?
tiè, questa funzione esporta in modo manuale, quindi mostrando una serie di
vari metodi che ti potranno essere utili, come esportare il contenuto di una
griglia su excel.
Non è fatta benissimo, è un po' incasinata però il suo lavoro lo fa e se te
la studi sei a posto.
E' contenuta dentro la dllglobal scaricabile dal sito comune.
Public Sub fnExportExcel(ByVal Grid As Control, ByVal sName As String, ByVal
sNomeApp As String, _
            Optional ByVal sColData As String, Optional ByVal nTipoDataIn As
enTipoData, Optional ByVal nTipoDataOut As enTipoData, _
            Optional ByVal sColStringa As String, Optional ByVal sColExport
As String)
    ' Parametri:
    ' CONTROL - CONTROLLO flexgrid o mshflexgrid DA CUI esportare
    ' sName  - nome da assegnare allo sheet di excel
    ' OPZIONALE sColdata - stringa con il numero delle colonne contenenti
una data,
    '            quindi da esportare in modo particolare
    '            valori separati da un meno "-"
    ' OPZIONALE nTipoDataIn Out - indica in che formato sono attualmente le
date e
    '           in che formato devono essere esportate
    ' OPZIONALE  sColStringa - indica quali colonne
    '            decono essere esportate con l'apice
    'OPZIONALE sColExport - Indica quali colonne esportare, se non viene
passato
    '            niente esporto tutte le colonne
    'ATTENZIONE, PER DEFAULT UNA COLONNA NON INDICATA NEI PARAMETRI VIENE
ESPORTATA
    '            COME NUMERO, CIOE' SENZA APICE
    Dim TempArrayParam() As String 'array di passaggio dove alloco i
parametri prima di
    '                    onvertirli in numero e metterli negli array
definitivi
    Dim nColData() As Integer 'array definitivo contenente un array delle
colonne contenenti
                            'una data
    Dim nColStringa() As Integer 'array definitivo contenente le colonne da
esportare con apice
    Dim nColExport() As Integer 'array che contiene le colonne da esportare
    Dim Cont As Long 'contatore generico, lo uso nei cicli
    Dim exclApp As Object
    Dim WKS As Object
    Dim NN, KK As Integer
    Dim nFieldsCount As Integer, nRecordCount As Long
    Set FN = New clsGlobal
    On Error GoTo err
    Screen.MousePointer = vbHourglass
    'se il parametro sColData non è vuoto passo i valori al mio array
temporaneo
    If Trim(sColData) <> "" Then
        TempArrayParam = Split(sColData, "-")
        'ora passo i valori del parametro scoldata all'array definitivo
        ReDim nColData(1 To UBound(TempArrayParam) + 1)
        Cont = 0
        Do Until Cont = UBound(TempArrayParam) + 1
            Cont = Cont + 1
            nColData(Cont) = CInt(TempArrayParam(Cont - 1))
        Loop
      End If
    'se il parametro scolstringa non è vuoto lo filtro e lo metto in array
    'svuoto l'array temporaneo per stare tranquillo
    ReDim TempArrayParam(0 To 0)
    If Trim(sColStringa) <> "" Then
        TempArrayParam = Split(sColStringa, "-")
        ReDim nColStringa(1 To UBound(TempArrayParam) + 1)
        'passo i parametri all'array definitivo
        Cont = 0
        Do Until Cont = UBound(TempArrayParam) + 1
            Cont = Cont + 1
            nColStringa(Cont) = CInt(TempArrayParam(Cont - 1))
        Loop
    End If
        'se il parametro scolexport è stato passato lo metto in array
         'svuoto l'array temporaneo per stare tranquillo
    ReDim TempArrayParam(0 To 0)
    If Trim(sColExport) <> "" Then
        TempArrayParam = Split(sColExport, "-")
        ReDim nColExport(1 To UBound(TempArrayParam) + 1)
        'passo i parametri all'array definitivo
        Cont = 0
        Do Until Cont = UBound(TempArrayParam) + 1
            Cont = Cont + 1
            nColExport(Cont) = CInt(TempArrayParam(Cont - 1))
        Loop
    End If
        'guinto a questo punto ho i parametri messi nei posti giusti
    'Rettifico il Nome Foglio (giusto per dormire tranquillo!):
    sName = Replace(Replace(Replace(sName, ":", ""), "\", ""), "/", "")
    sName = Replace(Replace(Replace(Replace(sName, "?", ""), "*", ""), "[",
""), "]", "")
    'dichiaro una variabile excel.application
    Set exclApp = GetObject(, "Excel.Application")
    '...e in caso di errore (significa che excel è chiuso) gestisco l'errore
e
    'apro excel...
Resuming:
    exclApp.Workbooks.Add 'aggiungo un file nuovo
    With exclApp
        .Visible = True
        With .activeWorkbook
            Set WKS = .Worksheets.Add
            ' Verifico se già esiste un foglio con lo stesso nome
            For NN = 1 To .Sheets.Count
                If sName = .Sheets(NN).Name Then
                    sName = sName + "-nuovo"
                End If
            Next NN
        End With
    End With
    'Assumo comunque che mi bastino 31 char...
    sName = Left(sName, 31)
    With WKS
        .CELLS.Delete
        .CELLS(1, 1) = sNomeApp & " - Esportazione Dati."
        .CELLS(2, 1) = "Attendere, lettura dati in corso: " & sName
    End With
    With Grid
        nFieldsCount = .Cols - 1
        nRecordCount = .Rows - 1
        .Row = 1
        .col = 1
    End With
    If nRecordCount = 0 Then
        With WKS
            .CELLS(4, 1) = "NESSUN dato disponibile"
            .CELLS(4, 1).Font.Bold = True
        End With
    Else
        If Trim(sColExport) = "" Then 'devo esportare tutte le colonne
            'Carico lo sheet con i dati
            Grid.Row = 0
            With WKS
                For KK = 1 To nFieldsCount
                    Grid.col = KK
                    If Left(Grid.Text, 1) = "=" Then
                       .CELLS(3, KK + 1).Value = "'" & Grid.Text
                       Else
                       .CELLS(3, KK + 1).Value = Grid.Text
                    End If
                Next KK
                WKS.Range(WKS.CELLS(3, 1), WKS.CELLS(3, nFieldsCount +
1)).Font.Bold = True
                Grid.col = 0
                Grid.Row = 0
                'scorro le righe
                Do Until Grid.Row = Grid.Rows - 1
                    Grid.col = 0
                    Grid.Row = Grid.Row + 1
                    'scorro le colonne
                    Do Until Grid.col = Grid.Cols - 1
                        Grid.col = Grid.col + 1
                        'eseguo prima l'esportazione normale
                        'controllo se il primo carrattere è "=", nel caso
metto l'apice
                            If Left(Grid.Text, 1) = "=" Then
                                WKS.CELLS(Grid.Row + 3, Grid.col + 1).Value
= "'" & Grid.Text
                                Else
                                    'scrivo la cella in modo standard
                                    WKS.CELLS(Grid.Row + 3, Grid.col +
1).Value = Grid.Text
                            End If
                        'verifico che la colonna non sia indicata in uno dei
parametri
                        'che indicano esportazioni particolari
                        If Trim(sColStringa) <> "" Then
                            Cont = 0
                            Do Until Cont = UBound(nColStringa)
                                Cont = Cont + 1
                                If nColStringa(Cont) = Grid.col Then
                                    'COLONNA DA ESPORTARE COME STRINGA
                                    WKS.CELLS(Grid.Row + 3, Grid.col +
1).Value = "'" & Grid.Text
                                End If
                            Loop
                          End If
                        If Trim(sColData) <> "" Then
                            Cont = 0
                            Do Until Cont = UBound(nColData)
                                Cont = Cont + 1
                                If nColData(Cont) = Grid.col Then
                                    'COLONNA DA ESPORTARE COME DATA
                                    'converto la data
                                    WKS.CELLS(Grid.Row + 3, Grid.col +
1).Value = FN.DbConvertiData(Grid.Text, nTipoDataIn, nTipoDataOut)
                                End If
                            Loop
                        End If
                    Loop
                Loop
                WKS.Columns.AutoFit
                WKS.Name = sName
                WKS.CELLS(2, 1).Value = "Lettura dati completata"
            End With
        Else 'devo esportare solo le colonne selezionate
            Dim nColSalt As Integer 'mi serve per contare le colonne saltate
                                'in modo tale da poter aggiustare i
riferimenti
                                'sulla griglia di excel(eliminare i buchi)
            nColSalt = 0
        'Carico lo sheet con i dati
            Grid.Row = 0
            With WKS
                For KK = 1 To nFieldsCount
                    Grid.col = KK
                    Dim bEsporta As Boolean
                    Cont = 0
                    Do Until Cont = UBound(nColExport) 'verifico se la
colonna è
                            'contenuta nell'array delle colonne da esportare
                        Cont = Cont + 1
                        If nColExport(Cont) = Grid.col Then 'la colonna è da
esportare
                            bEsporta = True
                            Exit Do
                            Else
                            bEsporta = False
                        End If
                    Loop
                    If bEsporta = True Then
                        If Left(Grid.Text, 1) = "=" Then
                            'da notare che aggiusto i riferimenti sottraendo
le
                            'colonne saltate
                           .CELLS(3, KK + 1 - nColSalt).Value = "'" &
Grid.Text
                           Else
                           'da notare che aggiusto i riferimenti sottraendo
le
                            'colonne saltate
                           .CELLS(3, KK + 1 - nColSalt).Value = Grid.Text
                        End If
                        bEsporta = False
                    Else
                        'non devo esportare questa colonna della griglia
                        'non esporto, quindi incremento
                        'il contatore delle colonne saltate
                        'e imposto il boolean a true
                        nColSalt = nColSalt + 1
                    End If
                Next KK
                WKS.Range(WKS.CELLS(3, 1), WKS.CELLS(3, nFieldsCount +
1)).Font.Bold = True
                Grid.col = 0
                Grid.Row = 0
                'scorro le righe
                Do Until Grid.Row = Grid.Rows - 1
                    Grid.col = 0
                    Grid.Row = Grid.Row + 1
                    'reimposto a zero il contatore delle colonne saltate,
                    'in quanto farò un nuovo ciclo di colonne
                    nColSalt = 0
                    'scorro le colonne
                    Do Until Grid.col = Grid.Cols - 1
                        Grid.col = Grid.col + 1
                        Cont = 0
                        Do Until Cont = UBound(nColExport) 'verifico se la
colonna è
                                'contenuta nell'array delle colonne da
esportare
                            Cont = Cont + 1
                            If nColExport(Cont) = Grid.col Then 'la colonna
è da esportare
                                bEsporta = True
                                Exit Do
                                Else
                                bEsporta = False
                            End If
                        Loop
                        'controllo se l'esportazione è da fare
                        If bEsporta = True Then
                          'eseguo prima l'esportazione normale
                            'eventuali successive esportazioni cancelleranno
questa
                          'controllo se il primo carrattere è "=", nel caso
metto l'apice
                              If Left(Grid.Text, 1) = "=" Then
                                  WKS.CELLS(Grid.Row + 3, Grid.col + 1 -
nColSalt).Value = "'" & Grid.Text
                                  Else
                                      'scrivo la cella in modo standard
                                      WKS.CELLS(Grid.Row + 3, Grid.col + 1 -
nColSalt).Value = Grid.Text
                              End If
                          'verifico che la colonna non sia indicata in uno
dei parametri
                          'che indicano esportazioni particolari
                          'esportazione come stringa
                          If Trim(sColStringa) <> "" Then
                              Cont = 0
                              Do Until Cont = UBound(nColStringa)
                                  Cont = Cont + 1
                                  If nColStringa(Cont) = Grid.col Then
                                      'COLONNA DA ESPORTARE COME STRINGA
                                      'da notare che aggiusto i riferimenti
sottraendo le
                                        'colonne saltate
                                      WKS.CELLS(Grid.Row + 3, Grid.col + 1 -
nColSalt).Value = "'" & Grid.Text
                                  End If
                                Loop
                          End If
                         'esportazione data
                        If Trim(sColData) <> "" Then
                            Cont = 0
                            Do Until Cont = UBound(nColData)
                                Cont = Cont + 1
                                If nColData(Cont) = Grid.col Then
                                    'COLONNA DA ESPORTARE COME DATA
                                    'converto la data
                                    WKS.CELLS(Grid.Row + 3, Grid.col + 1 -
nColSalt).Value = FN.DbConvertiData(Grid.Text, nTipoDataIn, nTipoDataOut)
                                End If
                            Loop
                        End If
                        Else
                            'non devo esportare questa colonna della griglia
                            'non esporto, quindi incremento
                            'il contatore delle colonne saltate
                            'e imposto il boolean a true
                            nColSalt = nColSalt + 1
                      End If
                        bEsporta = False
                    Loop
                Loop
                WKS.Columns.AutoFit
                WKS.Name = sName
                WKS.CELLS(2, 1).Value = "Lettura dati completata"
            End With
    End If
    End If
    Set exclApp = Nothing
    Set WKS = Nothing
    Screen.MousePointer = 0
    Set FN = Nothing
    Exit Sub
err:
    If err = 429 Then
        'Se Excel non è aperto
        err.Clear
        Set exclApp = CreateObject("Excel.Application")
        Resume Resuming
    Else
        ShowErrMsg
    End If
    Screen.MousePointer = 0
End Sub