valentina ferrari
unread,Apr 18, 2023, 8:53:26 AM4/18/23You do not have permission to delete messages in this group
Either email addresses are anonymous for this group or you need the view member email addresses permission to view the original message
to
Buongiorno,
Sto usando un DB in access nel quale c'è la possibilità di esportare in Excel su un file esistente.
Fino adesso mi serviva solo l'esportazione della tabella ingegneria, ma ora devo esportare anche quella relativa ai materiali.
Inserito c'è questo codice, di cui ho provato ad apportare delle modifiche per l'esportazione della seconda tabella Materiali.
Private Sub prova_Click()
Dim xlApp As Object, xlSheet As Object
Dim rs As Recordset, ExcelTargetRange As Object, FieldNum As Integer
Dim i As Long, j As Long, k As Long, TblIng, TblMat As String
Dim ExcelFileName As String, ExcelSheetING, ExcelSheetMAT As String
Dim ExcelStartCell As String
intRisposta = MsgBox("Vuoi ESPORTARE TUTTI I DATI IN EXCEL?", vbInformation + vbYesNo)
If intRisposta = vbNo Then
Response = acDataErrDisplay
Exit Sub
End If
' INGEGNERIA
If intRisposta = vbYes Then
TblIng = "P_Ingegneria"
FieldNum = 22
ExcelFileName = "C:\Users\PC\Desktop\Costi.xlsx"
ExcelSheetING = "Ingegneria"
ExcelStartCell = "A14"
Set db = CurrentDb
Set rs = db.OpenRecordset(TblIng, dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(ExcelFileName)
Set ExcelTargetRange = xlSheet.Sheets(ExcelSheetING).Range(ExcelStartCell)
End If
' MATERIALI
If intRisposta = vbYes Then
Tblmat = "P_MAteriali"
FieldNum = 22
ExcelFileName = "C:\Users\PC\Desktop\Costi.xlsx"
ExcelSheetMat = "Materiali"
ExcelStartCell2 = "A14"
Set db = CurrentDb
Set rs = db.OpenRecordset(TblMat, dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(ExcelFileName)
Set ExcelTargetRange= xlSheet.Sheets(ExcelSheetMat).Range(ExcelStartCell2)
End If
Do
k = k + 1
If IsEmpty(ExcelTargetRange(k, 1)) Then
Exit Do
End If
Loop
Do Until rs.EOF
For i = 1 To FieldNum
ExcelTargetRange(k, i) = rs.Fields(i - 1)
Next
k = k + 1
rs.MoveNext
Loop
xlSheet.Close SaveChanges:=True
End Sub
Mi dà errore però nella riga "Set ExcelTargetRange= xlSheet.Sheets(ExcelSheetMat).Range(ExcelStartCell2)" relativa ai materiali...Probabilmente devo inserire un altro rs all'inizio ma non so bene come...qualcuno mi può aiutare?
Grazie