1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
| Sub PNT_R()
Application.ScreenUpdating = False
DA = Range("F12").Value
Sheets("TX_Global_Zone").Select
LIGNE_DA = Cells.Find(what:=DA, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Dim Connexion As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim CheminBase As String
Dim CompteChamps As Long
Dim Requete As String
Dim NomTable As String
'Taux Global
CheminBase = "N:\Calexpress\13 - METHODES\13.2 Public\13.2.3 Divers\97 - Bases de données\POINTAGE\Taux_pointage.mdb"
Connexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & CheminBase & ";"
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
With Rs
.CursorLocation = adUseClient
.Open Requete, Connexion, adOpenDynamic, adLockOptimistic
End With
Range("B" & LIGNE_DA) = Rs.Fields("Somme_Colis")
Range("C" & LIGNE_DA) = Rs.Fields("Somme_Colis_non_lus")
Range("D" & LIGNE_DA) = Rs.Fields("Taux")
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
'Taux Mode
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.Mode"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.Mode"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
With Rs
.CursorLocation = adUseClient
.Open Requete, Connexion, adOpenDynamic, adLockOptimistic
End With
Do Until Rs.Fields("Mode").Value = "D"
Rs.MoveNext
Loop
Range("E" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Mode").Value = "R"
Rs.MoveNext
Loop
Range("F" & LIGNE_DA) = Rs.Fields("Taux")
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
'Taux Zone
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & ") AND ((Equipe.Equipe) Is Null));"
With Rs
.CursorLocation = adUseClient
.Open Requete, Connexion, adOpenDynamic, adLockOptimistic
End With
Do Until Rs.Fields("Zone").Value = "Z1"
Rs.MoveNext
Loop
Range("G" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z2"
Rs.MoveNext
Loop
Range("H" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z3"
Rs.MoveNext
Loop
Range("I" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z4"
Rs.MoveNext
Loop
Range("J" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z5"
Rs.MoveNext
Loop
Range("K" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z6"
Rs.MoveNext
Loop
Range("L" & LIGNE_DA) = Rs.Fields("Taux")
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
'Taux Equipe Nuit
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Equipe.Equipe"
Requete = Requete & " FROM (Expedition LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur) LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225) AND ((Equipe.Equipe)='N'));"
With Rs
.CursorLocation = adUseClient
.Open Requete, Connexion, adOpenDynamic, adLockOptimistic
End With
Range("M" & LIGNE_DA) = Rs.Fields("Taux")
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
'Taux CD
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.CD"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.CD"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225));"
With Rs
.CursorLocation = adUseClient
.Open Requete, Connexion, adOpenDynamic, adLockOptimistic
End With
Sheets("REQUETE").Range("A1").CopyFromRecordset Rs
Sheets("REQUETE").Select
lg = Range("A1").End(xlDown).Row
For i = 1 To lg
CD = Range("B" & i).Value
TX = Range("C" & i).Value
Sheets("TX_CD").Select
Set PlageDeRecherche = ActiveSheet.Rows(1)
Set Trouve = PlageDeRecherche.Cells.Find(what:=CD, LookAt:=xlWhole)
If Trouve Is Nothing Then
GoTo suite
Else
COLONNE = Trouve.Column
Set MaPlage = Columns(COLONNE).Rows(LIGNE_DA)
MaPlage.Value = TX
If MaPlage.Value = "" Then
MaPlage.Value = 100
End If
End If
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
suite:
Sheets("REQUETE").Select
Rs.close
Set Rs = Nothing
Set Connexion = Nothing
End Sub |