Esportare tab Access in foglio excel in determinate celle

[Domy73]

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

[Domy73]

Errata corrige

Nome ---> nella cella E2

Cognome ---> nella cella G2
Città ---> nella cella I2

[Domy73]

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?

[@Alex]

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

[Domy73]

@Alex ha scritto:

> Io uso questa Routine:

> EXP2XLS= False

> Set oWkb = xlApp.Workbooks.Add()

> DoEvents
> Loop

> End If

> oWkb.SaveAs NomeFile, 43

> Set rs = CurrentDb.OpenRecordset(SQL,dbOpenDynaset,dbReadOnly)

> EXP2XLS= True

> @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

[..:: GiGhEn ::..]

> >     ' Elimino i Fogli cheExcelcrea di DEFAULT

> mi venivano sovrascritte le celle inexcelora 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

[Antonio Biso]

"..:: GiGhEn ::.." <gigh...@gmail.com> ha scritto nel messaggio
news:358ae958-4491-4833...@q14g2000prh.googlegroups.com...

On 30 Mar, 14:11, domy1...@gmail.com (Domy73) wrote:
> @Alex ha scritto:

ma un piccolo sfoltimento del quoting, per la pubblica fruizione del thread?

Antonio

[Alessandro Cara]

Anto' fa caldo!

--

ac (x=y-1)

[Antonio Biso]

"Alessandro Cara" <alessan...@ay-1anetwork.it> 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