Ciao la routine è lunga perchè complessa e uso una transazione e per mia ignoranza non so come spezzare la routine
sta di fatto che finchè non ho cambiato office funzionava benissimo
Public Function GeneraFatture()
On Error GoTo Err_GeneraFatture
If MsgBox("Sei sicuro/a di voler" & vbNewLine & "generare le fatture?", vbCritical + vbYesNo, "Genera Fatture?") = vbYes Then
DoCmd.Hourglass True
Dim genfat As ADODB.Connection
Set genfat = CurrentProject.Connection
Dim strRptName As String
strRptName = "RptFatture"
Dim intNumFattura As Integer
Dim intAnno As Integer
Dim strRisposta As String
Dim strCriteria As String
Dim intIdFattura As Integer
Dim strQry As String
Dim strCriteriaQry As String
Dim strTipoContabilita As String
genfat.BeginTrans
Dim rstdit As ADODB.Recordset
Dim rstfat As ADODB.Recordset
Dim rstdetfat As ADODB.Recordset
Dim rstdetfateme As ADODB.Recordset
Dim rstFatture As ADODB.Recordset
Set rstdit = New ADODB.Recordset
Set rstfat = New ADODB.Recordset
Set rstdetfat = New ADODB.Recordset
Set rstdetfateme = New ADODB.Recordset
Set rstFatture = New ADODB.Recordset
rstdit.Open "QryDitteFatture", genfat, adOpenStatic, adLockOptimistic, adCmdTableDirect
rstfat.Open "TblFatture", genfat, adOpenStatic, adLockOptimistic, adCmdTableDirect
rstdetfat.Open "TblDettaglioFatture", genfat, adOpenStatic, adLockOptimistic, adCmdTableDirect
rstdetfateme.Open "TblDettaglioFattureDaEmettere", genfat, adOpenStatic, adLockOptimistic, adCmdTableDirect
intAnno = Year(Date)
intIdFattura = CalcolaNumFattura()
strCriteriaQry = "IdFattura >= " & intIdFattura & " And Anno = " & intAnno
strQry = "SELECT * From QryFAttureDoUntil WHERE " & strCriteriaQry
With rstdit
If .RecordCount > 0 Then
intNumFattura = CalcolaNumFattura() - 1
Do Until .EOF
If .Fields("NonFatturo") Then
.Fields("NonFatturo") = False
.MoveNext
Else
If .Fields("Rid") Then 'Verifica se pagano con la Rid
Select Case .Fields("TipoContabilità") '
Case "O" 'Contabilità ordinaria
rstfat.AddNew
intNumFattura = intNumFattura + 1
rstfat("IdFattura") = intNumFattura
rstfat("IdDitta") = .Fields("IdDitta")
rstfat("EmessaIl") = Date
rstfat("Anno") = intAnno
rstfat.Update
With rstdetfat
If IsNull(rstdit("Fatture")) Or rstdit("Fatture") = "" Then
Else
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 1
.Fields("Quantità") = 1
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strOrd & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strOrd & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Importo") = rstdit("Fatture")
.Fields("IdAliquotaIva") = 8
End If
If rstdit("Paghe") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 2
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = str13 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
.Fields("Quantità") = rstdit("Paghe") * 2
Else
.Fields("Descrizione") = strPag & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
.Fields("Quantità") = rstdit("Paghe")
End If
.Fields("Importo") = rstdit("QuotaPaghe") '* rstdit("Paghe")
.Fields("IdAliquotaIva") = 8
End If
If rstdit("F24") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strF24 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strF24 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Quantità") = rstdit("F24")
.Fields("Importo") = costof24
.Fields("IdAliquotaIva") = 8
rstdit.Fields("F24") = 0
End If
If rstdit("Cococo") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 2
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strCol & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strCol & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Quantità") = rstdit("Cococo")
.Fields("Importo") = rstdit("QuotaCococo")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Cococo") = 0
End If
If rstdit("770") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = str770 & Year(Date)
.Fields("Quantità") = rstdit("770")
.Fields("Importo") = rstdit("Quota770")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("770") = 0
End If
If rstdit("Inail") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strIna & Year(Date)
.Fields("Quantità") = rstdit("Inail")
.Fields("Importo") = rstdit("QuotaInail")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Inail") = 0
End If
If rstdit("Spesometro") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strSpe
.Fields("Quantità") = rstdit("Spesometro")
.Fields("Importo") = 50
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Spesometro") = 0
End If
If rstdit("Cu") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strCeu
.Fields("Quantità") = rstdit("Cu")
.Fields("Importo") = rstdit("QuotaCu")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Cu") = 0
End If
If rstdit("CassaVirtuale") = -1 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strIva
.Fields("Quantità") = 1
.Fields("Importo") = 40
.Fields("IdAliquotaIva") = 8
rstdit.Fields("CassaVirtuale") = 0
End If
rstdetfateme.Filter = "IdDitta = " & rstdit("IdDitta")
If rstdetfateme.RecordCount > 0 Then
Do Until rstdetfateme.EOF
If rstdetfateme("StopFatturo") Then
Else
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("Anno") = intAnno
.Fields("IdUnitàMisura") = rstdetfateme("IdUnitàMisura")
.Fields("Descrizione") = rstdetfateme("Descrizione")
.Fields("Quantità") = rstdetfateme("Quantità")
.Fields("Importo") = rstdetfateme("Importo")
.Fields("IdAliquotaIva") = rstdetfateme("IdAliquotaIva")
rstdetfateme.Delete
End If
rstdetfateme.MoveNext
Loop
End If
rstdetfateme.Filter = adFilterNone
.Update
End With
Case "S", "M", "F" 'Tipo di contabilità Semplificata Minimo Forfettario
Select Case .Fields("Periodo")
Case "M" 'Pagamento mensile
rstfat.AddNew
intNumFattura = intNumFattura + 1
rstfat("IdFattura") = intNumFattura
rstfat("IdDitta") = .Fields("IdDitta")
rstfat("EmessaIl") = Date
rstfat("Anno") = intAnno
rstfat.Update
With rstdetfat
If IsNull(rstdit("Fatture")) Or rstdit("Fatture") = "" Then
Else
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("Anno") = intAnno
.Fields("IdUnitàMisura") = 1
.Fields("Quantità") = 1
Select Case rstdit("TipoContabilità")
Case "S", "M", "F" 'semplificata, minima, forfettaria
strTipoContabilita = rstdit.Fields("Descrizione")
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strSem & strTipoContabilita & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strSem & strTipoContabilita & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
End Select
.Fields("Importo") = rstdit("Fatture")
.Fields("IdAliquotaIva") = 8
End If
If rstdit("Paghe") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 2
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = str13 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
.Fields("Quantità") = rstdit("Paghe") * 2
Else
.Fields("Descrizione") = strPag & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
.Fields("Quantità") = rstdit("Paghe")
End If
.Fields("Importo") = rstdit("QuotaPaghe") '* rstdit("Paghe")
.Fields("IdAliquotaIva") = 8
End If
If rstdit("F24") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strF24 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strF24 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Quantità") = rstdit("F24")
.Fields("Importo") = costof24
.Fields("IdAliquotaIva") = 8
rstdit.Fields("F24") = 0
End If
If rstdit("Cococo") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 2
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strCol & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strCol & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Quantità") = rstdit("Cococo")
.Fields("Importo") = rstdit("QuotaCococo")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Cococo") = 0
End If
If rstdit("770") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = str770 & Year(Date)
.Fields("Quantità") = rstdit("770")
.Fields("Importo") = rstdit("Quota770")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("770") = 0
End If
If rstdit("Inail") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strIna & Year(Date)
.Fields("Quantità") = rstdit("Inail")
.Fields("Importo") = rstdit("QuotaInail")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Inail") = 0
End If
If rstdit("Spesometro") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strSpe
.Fields("Quantità") = rstdit("Spesometro")
.Fields("Importo") = 50
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Spesometro") = 0
End If
If rstdit("Cu") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strCeu
.Fields("Quantità") = rstdit("Cu")
.Fields("Importo") = rstdit("QuotaCu")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Cu") = 0
End If
If rstdit("TipoContabilità") = "S" Then
If rstdit("CassaVirtuale") = -1 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 1
.Fields("Anno") = intAnno
.Fields("Descrizione") = strCav
.Fields("Quantità") = 1
.Fields("Importo") = 30
.Fields("IdAliquotaIva") = 8
rstdit.Fields("CassaVirtuale") = 0
End If
End If
rstdetfateme.Filter = "IdDitta = " & rstdit("IdDitta")
If rstdetfateme.RecordCount > 0 Then
Do Until rstdetfateme.EOF
If rstdetfateme("StopFatturo") Then
Else
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("Anno") = intAnno
.Fields("IdUnitàMisura") = rstdetfateme("IdUnitàMisura")
.Fields("Descrizione") = rstdetfateme("Descrizione")
.Fields("Quantità") = rstdetfateme("Quantità")
.Fields("Importo") = rstdetfateme("Importo")
.Fields("IdAliquotaIva") = rstdetfateme("IdAliquotaIva")
rstdetfateme.Delete
End If
rstdetfateme.MoveNext
Loop
End If
rstdetfateme.Filter = adFilterNone
.Update
End With
Case "T" 'Pagamento trimestrale
If Format(Date, "mmmm") = "gennaio" Or Format(Date, "mmmm") = "aprile" Or Format(Date, "mmmm") = "luglio" Or Format(Date, "mmmm") = "ottobre" Then
rstfat.AddNew
intNumFattura = intNumFattura + 1
rstfat("IdFattura") = intNumFattura
rstfat("Anno") = intAnno
rstfat("IdDitta") = .Fields("IdDitta")
rstfat("EmessaIl") = Date
rstfat.Update
With rstdetfat
If IsNull(rstdit("Fatture")) Or rstdit("Fatture") = "" Then
Else
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 1
.Fields("Quantità") = 3
.Fields("Anno") = intAnno
Select Case rstdit("TipoContabilità")
Case "S", "M", "F" 'Semplificata, Minima, Forfettaria
strTipoContabilita = rstdit.Fields("Descrizione")
Select Case Format(Date, "mmmm")
Case Is = "gennaio"
.Fields("Descrizione") = strSem & strTipoContabilita & "4° TRIMESTRE " & Year(DateAdd("yyyy", -1, Date))
Case Is = "aprile"
.Fields("Descrizione") = strSem & strTipoContabilita & "1° TRIMESTRE " & Year(Date)
Case Is = "luglio"
.Fields("Descrizione") = strSem & strTipoContabilita & "2° TRIMESTRE " & Year(Date)
Case Is = "ottobre"
.Fields("Descrizione") = strSem & strTipoContabilita & "3° TRIMESTRE " & Year(Date)
End Select
End Select
.Fields("Importo") = rstdit("Fatture")
.Fields("IdAliquotaIva") = 8
End If
If rstdit("Paghe") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 2
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = str13 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
.Fields("Quantità") = rstdit("Paghe") * 2
Else
.Fields("Descrizione") = strPag & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
.Fields("Quantità") = rstdit("Paghe")
End If
.Fields("Importo") = rstdit("QuotaPaghe") '* rstdit("Paghe")
.Fields("IdAliquotaIva") = 8
End If
If rstdit("F24") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strF24 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strF24 & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Quantità") = rstdit("F24")
.Fields("Importo") = costof24
.Fields("IdAliquotaIva") = 8
rstdit.Fields("F24") = 0
End If
If rstdit("Cococo") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 2
.Fields("Anno") = intAnno
If Format(Date, "mmmm") = "gennaio" Then
.Fields("Descrizione") = strCol & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(DateAdd("yyyy", -1, Date))
Else
.Fields("Descrizione") = strCol & UCase(Format(DateAdd("m", -1, (Date)), "mmmm")) & " " & Year(Date)
End If
.Fields("Quantità") = rstdit("Cococo")
.Fields("Importo") = rstdit("QuotaCococo")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Cococo") = 0
End If
If rstdit("770") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = str770 & Year(Date)
.Fields("Quantità") = rstdit("770")
.Fields("Importo") = rstdit("Quota770")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("770") = 0
End If
If rstdit("Inail") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strIna & Year(Date)
.Fields("Quantità") = rstdit("Inail")
.Fields("Importo") = rstdit("QuotaInail")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Inail") = 0
End If
If rstdit("Spesometro") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strSpe
.Fields("Quantità") = rstdit("Spesometro")
.Fields("Importo") = 50
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Spesometro") = 0
End If
If rstdit("Cu") > 0 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strCeu
.Fields("Quantità") = rstdit("Cu")
.Fields("Importo") = rstdit("QuotaCu")
.Fields("IdAliquotaIva") = 8
rstdit.Fields("Cu") = 0
End If
If rstdit("TipoContabilità") = "S" Then
If rstdit("CassaVirtuale") = -1 Then
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("IdUnitàMisura") = 3
.Fields("Anno") = intAnno
.Fields("Descrizione") = strCav
.Fields("Quantità") = 1
.Fields("Importo") = 30
.Fields("IdAliquotaIva") = 8
rstdit.Fields("CassaVirtuale") = 0
End If
End If
rstdetfateme.Filter = "IdDitta = " & rstdit("IdDitta")
If rstdetfateme.RecordCount > 0 Then
Do Until rstdetfateme.EOF
If rstdetfateme("StopFatturo") Then
Else
.AddNew
.Fields("IdFattura") = intNumFattura
.Fields("Anno") = intAnno
.Fields("IdUnitàMisura") = rstdetfateme("IdUnitàMisura")
.Fields("Descrizione") = rstdetfateme("Descrizione")
.Fields("Quantità") = rstdetfateme("Quantità")
.Fields("Importo") = rstdetfateme("Importo")
.Fields("IdAliquotaIva") = rstdetfateme("IdAliquotaIva")
rstdetfateme.Delete
End If
rstdetfateme.MoveNext
Loop
End If
rstdetfateme.Filter = adFilterNone
.Update
End With
Exit_GeneraFatture:
Exit Function
Err_GeneraFatture:
MsgBox Err.Description
genfat.RollbackTrans
genfat.Close
Set genfat = Nothing
MsgBox Err.Description
Resume Exit_GeneraFatture
End Function
La routine intera non ci stà neppure nel forum