Newsgroup: it.comp.appl.access
Titolo: Esportare tab Access in foglio excel in determinate celle

Salve a tutti ho una tabella "MiaTabella" con i seguenti campi:
Nome,Cognome,Citta
attraverso l'evento click di un pulsante posto su una maschera esporto i
dati di tale tabella in un file excel "MioFile.xls" già predisposto dove
in :
A1 ---> c'è scritto Nome
B1 ---> c'è scritto Cognome
C1 ---> c'è scritto Citta
quindi come detto prima sull'evento click del pulsante c'è questo codice
che mi esporta i dati nel file excel
Private Sub Comando0_Click()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "MiaTabella",
"C:DocumentiMioFile.xls", true, "foglio1!A1:G12" 
End Sub
Vorrei sapere come posso specificare le celle diverse dalle prime tre
A1,B1,C1 di excel in cui copiare i dati ?
Per esempio se volessi copiare:
Nome      ---> nella cella E2
Cognome   ---> nella cella F2
Città     ---> nella cella G2  
Come dovrei fare a specificare
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

Errata corrige
Nome      ---> nella cella E2
Cognome   ---> nella cella G2
Città     ---> nella cella I2 


Ho trovato nel ng qualcosa ma non mi funziona correttamente scrivo qui il
codice:
************************************************************
Private Sub ESPORTA_Click()
Dim excApp As Object
    Dim excDoc As Object
    Dim blOpen As Boolean
    Dim rst As Recordset
   On Error Resume Next
    blOpen = True
    Set excApp = GetObject(, "Excel.Application")
 
    If Err.Number = 429 Then
        Set excApp = CreateObject("Excel.Application")
        blOpen = False
        Err.Number = 0
            End If
    On Error GoTo gestErrori
 
 
 
    Set excDoc =
excApp.workbooks.Open("D:_administratordesktopCollegaTabLista.xls")
    excApp.Visible = True
 
    Set rst = CurrentDb.OpenRecordset("tb_Anagrafica")
 
    With rst
 
    .MoveFirst
 
    While Not .EOF
 
    excDoc.Worksheets(1).Cells(2, 2) = !Nome  'Cells(Riga, Colonna)
    excDoc.Worksheets(1).Cells(2, 4) = !Cognome
    excDoc.Worksheets(1).Cells(2, 6) = !Citta
    .MoveNext 'passa al prossimo record
 
    Wend
 
    End With
 
   rst.Close
   Set rst = Nothing
 
    If Not blOpen Then
        excDoc.Close savechanges:=False
        excApp.Application.Quit
    End If
esci:
    Set excDoc = Nothing
    Set excApp = Nothing
    Exit Sub
gestErrori:
    MsgBox Err.Number & " - " & Err.description
    GoTo esci
End Sub
************************************************************
Il problema credo che sia in questa parte del codice che non mi fa
funzionare l'esportazione:
*******************************************************************
Set rst = CurrentDb.OpenRecordset("tb_Anagrafica")
 
    With rst
 
    .MoveFirst
 
    While Not .EOF
 
    excDoc.Worksheets(1).Cells(2, 2) = !Nome  'Cells(Riga, Colonna)
    excDoc.Worksheets(1).Cells(2, 4) = !Cognome
    excDoc.Worksheets(1).Cells(2, 6) = !Citta
    .MoveNext 'passa al prossimo record
 
    Wend
 
    End With
 
   rst.Close
   Set rst = Nothing
******************************************************************
Qualcuno per favore sa darmi una dritta?


Io uso questa Routine:
Function EXP2XLS(SQL    as string, _
                 Optional ByRef NomeFile As String = vbNullString, _
                 Optional OpenDialog As Boolean = False, _
                 Optional CloseExcel As Boolean = True) As Boolean
    On Error GoTo Handle_err
    Dim xlApp   As Object   ' Oggetto EXCEL
    Dim oWkb    As Object   ' Oggetto WORKBOOK
    Dim x       As Integer
    Dim rs      As DAO.Recordset
    EXP2XLS= False
    ' APRE SE ESISTE GIA' UN'OGGETTO EXCEL
    Set xlApp = CreateObject("Excel.Application")
    Set oWkb = xlApp.Workbooks.Add()
    If OpenDialog = True Then
        Do Until NomeFile <> ""
            NomeFile = xlApp.GetSaveAsFilename(InitialFilename:="C:
\TestExport.xls", _
                                               fileFilter:="Excel
Files (*.xls), *.xls", _
                                               Title:="SELEZIONA NOME
FILE")
            DoEvents
        Loop
    End If
    If Len(NomeFile) = 0 Then NomeFile = "C:\TestExport.xls"
    If EsisteFile(NomeFile) Then Kill NomeFile
    oWkb.SaveAs NomeFile, 43
    ' Elimino i Fogli che Excel crea di DEFAULT
    For x = oWkb.Sheets.Count To 2 Step -1
        oWkb.Sheets(x).Delete
    Next
    ' Assegno un nome al Foglio(Sheet) rimasto.
    oWkb.Sheets(1).Name = "MANUTENZIONI"
    Set rs = CurrentDb.OpenRecordset(SQL,dbOpenDynaset,dbReadOnly)
    ' Scrivo nella Cella A1, se vuoi modificare l'inizio cambia il
riferimento
    oWkb.Sheets(1).Range("A1").CopyFromRecordset rs
    rs.Close
    Set rs = Nothing
    EXP2XLS= True
Exit_Here:
    oWkb.Save
    If CloseExcel Then
        oWkb.Close True
        xlApp.Quit
    Else
        xlApp.Visible = True
    End If
    Set oWkb = Nothing
    Set xlApp = Nothing
    Exit Function
Handle_err:
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_Here
End Function
@Alex

 @Alex
Grazie  tante per il tuo aiuto Alex, tuttavia  sono riscito a correggere
ed a far funzionare il codice;
*******************************************************************
Private Sub ESPORTA_Click()
Dim excApp As Object
    Dim excDoc As Object
    Dim blOpen As Boolean
    Dim rst As Recordset
    Dim n As Integer
 
   On Error Resume Next
    blOpen = True
    Set excApp = GetObject(, "Excel.Application")
 
    If Err.Number = 429 Then
        Set excApp = CreateObject("Excel.Application")
        blOpen = False
        Err.Number = 0
            End If
    On Error GoTo gestErrori
 
 
 
    Set excDoc =
excApp.workbooks.Open("D:_administratordesktopCollegaTabLista.xls")
    excApp.Visible = True
 
 
    'Apro il recordset
    Set rst = CurrentDb.OpenRecordset("tb_Anagrafica")
 
    'contatore righe tb_Anagrafica
    n = 1 
 
   'Copia tutti i record di tb_Anagrafica nel file excel
 
    With rst
 
    .MoveFirst ' mi sposto su primo record
 
    While Not .EOF
 
    n = n + 1
    excDoc.Worksheets(1).Cells(n, 2) = !Nome  'Cells(Riga, Colonna)
    excDoc.Worksheets(1).Cells(n, 4) = !Cognome
    excDoc.Worksheets(1).Cells(n, 6) = !Citta
    .MoveNext 'passa al prossimo record
 
    Wend
 
    End With
 
   rst.Close
   Set rst = Nothing
 
    If Not blOpen Then
        excDoc.Close savechanges:=False
        excApp.Application.Quit
    End If
esci:
    Set excDoc = Nothing
    Set excApp = Nothing
    Exit Sub
gestErrori:
    MsgBox Err.Number & " - " & Err.description
    GoTo esci
End Sub
************************************************************************
Non avevo inserito una variabile (n) che gestisse il nuovo record infatti
mi venivano sovrascritte le celle in excel ora funziona alla grande
spero possa essere di aiuto ad altri
ciauuuuuuuuuuuuu
ANCORA UN GRAZIE AD ALEX


 questo articolo e` stato inviato via web dal servizio gratuitohttp://
www.newsland.it/newssegnala
 gli abusi ad 
ab...@newsland.it
Ciao, hai posto un problema molto simile a quello che sto cercando io
solo che invece di esportare solo i tre campi che hai citato a me
servirebbe per piu' campi senza saltare nessuna colonna e ne riga ed
estrapolati da due tabelle. Hai modo di potermi dare una mano?
Ti posto lo stesso tuo codice con le mie modifiche senza sapere in che
parte di codice devo inserire la seconda tabella.
Il codice
modificato----------------------------------------------------------------
Private Sub ESPORTA_Click()
Dim excApp As Object
    Dim excDoc As Object
    Dim blOpen As Boolean
    Dim rst As Recordset
    Dim n As Integer
   On Error Resume Next
    blOpen = True
    Set excApp = GetObject(, "Excel.Application")
    If Err.Number = 429 Then
        Set excApp = CreateObject("Excel.Application")
        blOpen = False
        Err.Number = 0
            End If
    On Error GoTo gestErrori
    Set excDoc = excApp.workbooks.Open("C:\Documents and Settings
\Bifulco1\Desktop\SOCI\CONSOLIDATO 2011\CONSOLIDATO.xlsx")
    excApp.Visible = True
    'Apro il recordset
    Set rst = CurrentDb.OpenRecordset("SOCI GENERALE")
    'contatore righe tb_Anagrafica
    n = 1
   'Copia tutti i record di SOCI GENERALE nel file excel
    With rst
    .MoveFirst ' mi sposto su primo record
    While Not .EOF
    n = n + 1
    excDoc.Worksheets(1).Cells(n, 1) = !GRUPPO_DI  'Cells(Riga,
Colonna)
    excDoc.Worksheets(1).Cells(n, 2) = !COGNOME
    excDoc.Worksheets(1).Cells(n, 3) = !NOME
    excDoc.Worksheets(1).Cells(n, 4) = !LUOGO_NASCITA
    excDoc.Worksheets(1).Cells(n, 5) = !DATA_NASCITA
    excDoc.Worksheets(1).Cells(n, 6) = !COMP_CRI
    .MoveNext 'passa al prossimo record
    Wend
    End With
   rst.Close
   Set rst = Nothing
    If Not blOpen Then
        excDoc.Close savechanges:=False
        excApp.Application.Quit
    End If
esci:
    Set excDoc = Nothing
    Set excApp = Nothing
    Exit Sub
gestErrori:
    MsgBox Err.Number & " - " & Err.Description
    GoTo esci
End Sub
-----------------------------------------------------------------------------
Queto funziona anche a me (oquasi) però ad un certo punto, quando
finisce di esportare, mi sichiude il file di excel e quando lo riapro
scopro che non hai importato un bel nulla.
Cosa mi consigli di fare?
Grazie

 @Alex ha scritto:
ma un piccolo sfoltimento del quoting, per la pubblica fruizione del thread?
Antonio 


Anto' fa caldo!
-- 
ac (x=y-1)

 ha scritto nel messaggio 
news:8sODp.28006$GZ3....@tornado.fastwebnet.it...

a maggior ragione!
il quoting selvaggio, con lo scrolling obbligatorio, accalora il dito e 
aumenta il riscaldamento globale
che te lo dico a fa?
Antonio