[VBA/ACCESS] Generare file Excel da query ma con intestazione e conteggi

[nicola75ss]

Salve a tutti. Avrei bisogno del vostro aiuto per venire a capo del seguente problema.

Spiego il tutto nel modo più semplice possibile. Supponendo di avere una query in access così

nome  cognome   valore
mario      rossi       uno
giovanni  bianchi    due
andrea    verdi       uno
franco     gialli        tre

dovrei generare un file di excel che mi riporti nella riga 1 un semplice titolo (ad esempio risultato query), nelle righe successive le intestazioni di colonna con i relativi record e, una volta conclusa l'importazione dei record mi servirebbero alcune righe riepilogative del genere

uno 2
due 1
tre 1

Per il momento sono riuscito a creare il semplice file di excel contenente solo i record in due modi, con il comando Docmd.OutputTo e Docmd.TransferSpreadsheet ma per fare ciò che vorrei nessuno fa al caso mio.
P.S. Inoltre i due metodi su citati forzano la creazione del file mentre se fosse possibile mi piacerebbe che il file venisse semplicemente creato e che poi potesse decidere l'utente se e dove salvarlo.
Confido nel vostro prezioso aiuto.

edit. Se può essere d'aiuto il numero di righe che dovranno contenere i subtotali è fisso ed è pari a 4. In pratica mi servirebbe applicare a queste 4 righe la funzione conta.se di excel specificando per ciascuna uno dei 4 possibili valori nel range di righe generato dinamicamente dalla query.

[nicola75ss]

Fiducioso in una vostra risposta ho scritto con l'aiuto di google questo codice

Private Sub Comando0_Click()

Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim acQuery As QueryDef
Dim objRST As Recordset
Dim strQueryName As String
strQueryName = "nominativi"
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)
    
Set xlSheet = xlWorkbook.Sheets(1)

      xlSheet.Cells(1, 1).Value = "Risultati finali"
      xlSheet.Cells(1, 1).Font.Color = RGB(255, 0, 0)

      xlSheet.Range("A1:D1").Merge
      'Selection.Columns.AutoFit

    For lvlColumn = 0 To objRST.Fields.Count - 1
      xlSheet.Cells(2, lvlColumn + 1).Value = _
      objRST.Fields(lvlColumn).Name
    Next
    'Change the font to bold for the header row
    xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).Font.Bold = True
    
    xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).Font.Size = 10
    
    xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).HorizontalAlignment = xlCenter
        
     
    'Add a border to header row cells
    With xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlSheet.Range(xlSheet.Cells(1, 1), _
    xlSheet.Cells(2, objRST.Fields.Count)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

With xlSheet
    .Range("A3").CopyFromRecordset objRST
    .Name = Left(strQueryName, 31)
End With

xlSheet.Cells(18, 1).Value = "lavorativi"
xlSheet.Cells(19, 1).Value = "formativi"
xlSheet.Cells(20, 1).Value = "avvio impresa"
xlSheet.Cells(21, 1).Value = "altro"
xlSheet.Cells(22, 1).Value = "Totale"


lavorativi = xlApp.CountIf(Range("d3:d15"), "lavorativo")
xlSheet.Cells(18, 4).Value = lavorativi

formativi = xlApp.CountIf(Range("d3:d15"), "formativo")
xlSheet.Cells(19, 4).Value = formativi

avvioImpresa = xlApp.CountIf(Range("d3:d15"), "avvio impresa")
xlSheet.Cells(20, 4).Value = avvioImpresa

altro = xlApp.CountIf(Range("d3:d15"), "altro")
xlSheet.Cells(21, 4).Value = altro

totale = lavorativi + formativi + avvioImpresa + altro
xlSheet.Cells(22, 4).Value = totale


Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

Ho da porvi alcune domande:
1) Come faccio ad adattare automaticamente la larghezza delle colonne. Cercando su internet ho letto di selection.columns.autofit ma non sono riuscito ad integrarlo nel mio codice.
2) Perchè la funzione conta se mi restituisce i risultati corretti esattamente una volta su due (nel senso che premo il pulsante e funziona, lo ripremo e non mi viene visualizzato nessun valore numerico e in compenso mi appare una finestra di errore di runtime '1004' Metodo Range dell'oggetto '_Global' non riuscito, lo ripremo e funziona e così via.
3) Terza e ultima domanda. In questa mia prova ho specificato le celle in cui visualizzare i risultati (le righe da 18 a 22) ma ovviamente non so a priori il numero di record restituito dalla query e quindi dovrei accodare tali conteggi alla fine. Come faccio?

Grazie per l'attenzione.

[nicola75ss]

Alla terza domanda mi rispondo da solo.
E' sufficiente che conti il numero dei record così

totRecord = objRST.RecordCount

e per le celle sottostanti metta ad esempio

xlSheet.Cells(totRecord + 4, 1).Value = "lavorativi"
xlSheet.Cells(totRecord + 5, 1).Value = "formativi"
.....

Per le altre due domande spero nel vostro aiuto.

[nicola75ss]

Ah, mi sono dimenticato di chiedere un'altra cosa.

Il mio range statico d3:d15 di prova

formativi = xlApp.CountIf(Range("d3:d15"), "formativo")

come lo devo scrivere affinchè diventi "d3: d totRecord + 2" ?