Para el ejemplo he creado la misma tabla y datos en PostgreSQL.
FORMULARIO
CÓDIGO DEL BOTÓN Crear Query
Private Sub btnCrearQuery_Click()
Dim strQuery As String
Dim strTitulo As String
Dim intReg As Integer
strQuery = "qyrTotalNovedadAnnoMesEmpleado"
If Not (IsNull(Me.cboPeriodo) Or IsNull(Me.cboMes)) Then
strTitulo = "AÑO: " & Me.cboPeriodo & " MES: " & Me.cboMes.Column(1)
Call CreaQuerySubtotalPorAnnoMesEmpleado(strQuery, Val(Me.cboPeriodo), Val(Me.cboMes))
intReg = DCount("*", strQuery)
If intReg > 1 Then
DoCmd.OpenForm "frmEjemploTotalEmpAnnoMes", , , , , , strTitulo
Else
MsgBox "No hay registros que cumplan la condición", vbInformation, "Le informo"
Exit Sub
End If
ElseIf Not IsNull(Me.cboPeriodo) Then
Call CreaQuerySubtotalPorAnnoMesEmpleado(strQuery, Val(Me.cboPeriodo))
strTitulo = "AÑO: " & Me.cboPeriodo
DoCmd.OpenForm "frmEjemploTotalEmpAnnoMes", , , , , , strTitulo
Else
MsgBox "Se requiere el año", vbInformation, "Paso a Través"
Me.cboPeriodo.SetFocus
End If
End Sub
He programado el botón para consultar el año y mes o únicamente el año. Igualmente, adicioné el formulario y un informe con base en el resultado de la consulta paso a través. La consulta paso a través la creo con la función CreaQuerySubtotalPorAnnoMesEmpleado.
CÓDIGO DE LA FUNCIÓN CreaQuerySubtotalPorAnnoMesEmpleado
Public Function CreaQuerySubtotalPorAnnoMesEmpleado(SPTQueryName As String, intperiodo As Integer, Optional intmes As Integer)
'Obtiene el subtotal por empleado de la columna idconcepto y el total general
'pueder ser de un año completo o un mes del año
' Microsfot ActiveX Data Objectc 6.1 Library
' Microsfot ADO Ext. 6.0 for DLL and Security
'Fuente:
' Microsoft
'Adpatación para PostgreSQL
'Eduardo Pérez Fernández
'Fecha: 10/10/2022
'Parametros
' SPTQueryName --> Nombre de la consulta a crear
' intperiodo --> El año a consultar
' intmes --> El mes a consultar
On Error GoTo hay_Error
Dim cat As ADOX.Catalog
Dim cmd As ADODB.Command
Dim strSQl As String
Dim tB As DAO.TableDef
Dim MyQueryDef As QueryDef
With CurrentDb
For Each MyQueryDef In CurrentDb.QueryDefs
If MyQueryDef.Name = SPTQueryName Then
.QueryDefs.Delete (SPTQueryName)
.QueryDefs.Refresh
Exit For
End If
Next
End With
Set cat = New ADOX.Catalog
Set cmd = New ADODB.Command
cat.ActiveConnection = CurrentProject.Connection
Set cmd.ActiveConnection = cat.ActiveConnection
If intmes > 0 Then
strSQl = "SELECT idempleado,idconcepto" & vbCrLf
strSQl = strSQl & " , COUNT (idconcepto) AS registros " & vbCrLf
strSQl = strSQl & " , SUM (valor) AS suma_nov " & vbCrLf
strSQl = strSQl & " FROM tblnovedades_dos " & vbCrLf
strSQl = strSQl & " WHERE EXTRACT (YEAR " & vbCrLf
strSQl = strSQl & " FROM fecha_novedad)=" & intperiodo & vbCrLf
strSQl = strSQl & " AND EXTRACT (MONTH " & vbCrLf
strSQl = strSQl & " FROM fecha_novedad)=" & intmes & vbCrLf
strSQl = strSQl & " GROUP BY ROLLUP (idempleado" & vbCrLf
strSQl = strSQl & " , idconcepto) " & vbCrLf
strSQl = strSQl & " ORDER BY idempleado;"
Else
strSQl = "SELECT idempleado,idconcepto" & vbCrLf
strSQl = strSQl & " , COUNT (idconcepto) AS registros " & vbCrLf
strSQl = strSQl & " , SUM (valor) AS suma_nov" & vbCrLf
strSQl = strSQl & " FROM tblnovedades_dos " & vbCrLf
strSQl = strSQl & " WHERE EXTRACT (YEAR " & vbCrLf
strSQl = strSQl & " FROM fecha_novedad)=" & intperiodo & vbCrLf
strSQl = strSQl & " GROUP BY ROLLUP (idempleado" & vbCrLf
strSQl = strSQl & " , idconcepto) " & vbCrLf
strSQl = strSQl & " ORDER BY idempleado;"
End If
cmd.CommandText = strSQl
cmd.Properties("Jet OLEDB:ODBC Pass-Through Statement") = True
cmd.Properties _
("Jet OLEDB:Pass Through Query Connect String") = _
"ODBC;DSN=dbconta;"
cat.Procedures.Append SPTQueryName, cmd
Set cat = Nothing
Set cmd = Nothing
hay_Error_Exit:
Exit Function
hay_Error:
MsgBox "Ocurrió el error " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error..."
Resume hay_Error_Exit
End Function
Al hacer clic en el botón Crear Query se crea la consulta y se abre el formulario.
Para los colores utilizo formato condicional. Efectivamente obtengo lo solicitado, adicioné un informe que tiene como origen de datos la consulta.
Le dejo el script SQL si lo quiere probar en PostgreSQL.
Como puede apreciar el script es muy sencillo, la clave está en utilizar ROLLUP, sirve para generar múltiples grupos de agrupación, obtener los subtotales y el gran total. Esta es una de las grandes ventajas de utilizar PostgreSQL en relación con Access a pesar de que algunos digan que "para que PostgreSQL", no obstante, si la tabla estuviera vinculada NO es necesario el script y se crearía un reporte agrupando subtotales y total general, sin embargo, no es fácil producir un formulario similar, pero la pregunta es muy clara dice "Paso a través"