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 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423
|
Public Sub Import() 'En test Import Automatique
Dim oApp As New Excel.Application
Dim oWkb As New Excel.Workbook
Dim oWSht As New Excel.Worksheet 'feuille de calcul
Dim fDlg As Office.FileDialog
Dim strFichier As String
Dim cSQL As String
Dim cSQL22 As String
Dim csql2 As String
Dim c2SQL4 As String
Dim c3SQL4 As String
Dim cSQL444 As String
Dim cSQL4444 As String
Dim cSQL445 As String
Dim c3SQL5 As String
Dim cSQL4445 As String
Dim cSQL4446 As String
Dim c3SQL6 As String
Dim cSQL446 As String
Dim c3SQL7 As String
Dim cSQL447 As String
Dim nbre_col As Integer
Dim NomFic As String
Dim i As Integer
Dim Prov As Boolean
Dim num_col, lettre_col As Variant
Dim strCellModifiee As String
' Variables pour Import Excel
Dim NumDemRef As Integer
Dim NumDemNRef As Integer
Dim TypeDem_Etoile As Integer
Dim TypeDem As Integer
Dim DateDem As Integer
Dim LivAtt As Integer
Dim Service As Integer
Dim N_Archives As Integer
Dim AncienNum As Integer
Dim NomMed As Integer
Dim SECTEUR As Integer
Dim Descr As Integer
Dim DateDeb As Integer
Dim DateClot As Integer
Dim NIP As Integer
Dim NomFam As Integer
Dim NomUsage As Integer
Dim Prenom As Integer
Dim DateNaiss As Integer
Dim DateDC As Integer
Dim Sexe As Integer
Dim UG_DEST As Integer
Dim CommDem As Integer
Dim InfosComp As Integer
Dim NumCont As Integer
Dim Empl As Integer
Dim Change As Boolean
' Valeur de la cellule Excel importée
Dim valCel As String
Dim valCelReel As String
' Tableau des valeurs positions des colonnes fichier Excel importé
Dim Tableau As Currency
Dim iT As Integer
'Copie du fichier Exporté d'Excel
' Ouverture du fichier Excel
Set oWkb = oApp.Workbooks.Open(DLookup("[CHEMIN_FICHIER_IMPORT]", "TAB_PARAMETRE") & DLookup("[NOM_FICHIER_IMPORT]", "TAB_PARAMETRE"))
Set oWSht = oWkb.Worksheets(DLookup("[ONGLET_FICHIER_IMPORT]", "TAB_PARAMETRE")) ' le nom de la feuille qui contient les données à importer
On Error GoTo Ges_Err
oWSht.Range("A" & 1).Select
num_col = oWSht.Range("A" & 1).Column 'num_col=1
lettre_col = NumCol2Lettre(num_col) 'lettre_col="A"
While oWSht.Range(lettre_col & 1) <> ""
valCel = oWSht.Range(lettre_col & 1).Value
Select Case num_col 'voir case 9
Case 1
If valCel = "N° de demande" Then
NumDemRef = num_col
Else 'cas jamais arrivé ou libéllé différent je ne traite pas pour le moment
Change = True
End If
Case 2
If valCel = "N° de demande" Then
NumDemNRef = num_col
Else 'cas jamais arrivé ou libéllé différent je ne traite pas pour le moment
End If
Case 3
If valCel = "Type de la demande *" Then
TypeDem_Etoile = num_col
Else 'cas jamais arrivé ou libéllé différent je ne traite pas pour le moment
valCelReel = "Type de la demande *"
TypeDem_Etoile = ReelNumCol(valCelReel)
End If
Case 4
If valCel = "Type de la demande" Then
TypeDem = num_col
Else 'cas ou libéllé différent
valCelReel = "Type de la demande"
TypeDem = ReelNumCol(valCelReel)
End If
Case 5
If valCel = "Date demande" Then
DateDem = num_col
Else 'cas ou libéllé différent
valCelReel = "Date demande"
DateDem = ReelNumCol(valCelReel)
End If
Case 6
If valCel = "Livraison attendue" Then
LivAtt = num_col
Else 'cas ou libéllé différent
valCelReel = "Livraison attendue"
TypeDem = ReelNumCol(valCelReel)
End If
Case 7
If valCel = "Service" Then
Service = num_col
Else 'cas ou libéllé différent
valCelReel = "Service"
Service = ReelNumCol(valCelReel)
End If
Case 8
If valCel = "N° archives" Then
N_Archives = num_col
Else 'cas ou libéllé différent
valCelReel = "N° archives"
N_Archives = ReelNumCol(valCelReel)
End If
Case 9
If valCel = "Ancien numéro" Then
AncienNum = num_col
Else 'cas ou libéllé différent
valCelReel = "Ancien numéro"
AncienNum = ReelNumCol(valCelReel)
End If
end select
num_col = Range(lettre_col & 1).Column + 1
lettre_col = NumCol2Lettre(num_col)
oWSht.Range(lettre_col & 1).Select
wend
i = 2
DoCmd.SetWarnings False
MsgBox ("Importation en cours ")
'arrêter l'importation lorsque le programme rencontre une case vide en remplaçant la ligne du While par :
While oWSht.Range("A" & i).Value <> "" Or oWSht.Range("B" & i).Value <> "" '(où I représente la colonne et i la ligne)
cSQL = "insert into [TAB_IMPORT] ( [EMPLACEMENT], [NUM_CONTENANT], [NUM_ARCHIVES], [SECTEUR],[Date_Liv_Att], [SERVICE],[NIP],[NOM_DE_FAMILLE],[NOM_D_USAGE],[PRENOM],[DATE_NAISS],[SEXE], [DESCRIPTIF], [UG_DEST],[COMM],[Infos_Compl], [NUM_DEMANDE], [ARMOIRE], [SALLE])" & _
"values ("
cSQL = cSQL & Chr(34) & oWSht.Cells(i, Empl) & Chr(34) 'Emplacement (21)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NumCont) & Chr(34) 'Num contenant (20)
If oWSht.Cells(i, 8).Value <> "" Then
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, N_Archives) & Chr(34) 'Num archives
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, AncienNum) & Chr(34) 'Num archives Non Réf
End If
Match_Insertions oWSht.Cells(i, 27), oWSht.Cells(i, N_Archives) 'Emplacement dossier et N° Dossier
'Permet de voir si sur ce Dossier de voir s'il existe une Insertion
'Si oui met à jour Date_Trait sur la table Insertion
'à la date du jour
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, SECTEUR) & Chr(34) 'Secteur (10)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, LivAtt) & Chr(34) 'Date Liv Atendue
cSQL = cSQL & ", " & Chr(34) & Right(oWSht.Cells(i, Service), 6) & Chr(34) 'Service (7)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NIP) & Chr(34) 'NIP
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NomFam) & Chr(34) 'Nom de FAmille
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NomUsage) & Chr(34) 'Nom d'usage
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, Prenom) & Chr(34) 'Prénom
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, DateNaiss) & Chr(34) 'Date de Naissance
cSQL = cSQL & ", " & Chr(34) & Left(oWSht.Cells(i, Sexe), 1) & Chr(34) 'Sexe (18)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, Descr) & Chr(34) 'Descriptif (11)
cSQL = cSQL & ", " & Chr(34) & Left(oWSht.Cells(i, UG_DEST), 8) & Chr(34) 'UG destinataire (19)
' Gestion des caractères spéciaux guillemets pour le champ Commentaires et Infos Compl
If InStr(oWSht.Cells(i, CommDem), """") <> 0 Then
strCellModifiee = oWSht.Cells(i, CommDem)
cSQL = cSQL & ", " & Chr(34) & Replace(strCellModifiee, """", " ") & Chr(34) 'Commentaires
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, CommDem) & Chr(34) 'Commentaires
End If
If InStr(oWSht.Cells(i, InfosComp), """") <> 0 Then
strCellModifiee = oWSht.Cells(i, InfosComp)
cSQL = cSQL & ", " & Chr(34) & Replace(strCellModifiee, """", " ") & Chr(34) 'Infos Compl
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, InfosComp) & Chr(34) 'Infos Compl
End If If oWSht.Range("A" & i).Value <> "" Then
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NumDemRef) & Chr(34) 'Num Demande
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NumDemNRef) & Chr(34) 'Num Demande
End If
cSQL = cSQL & "," & "NULL"
cSQL = cSQL & "," & "NULL"
cSQL = cSQL & ");"
DoCmd.RunSQL cSQL
'Code 128
If oWSht.Cells(i, NumDemRef) <> "" Then
strCellModifiee = oWSht.Cells(i, 1)
cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[Num128]='" & Replace(Code128$(strCellModifiee), "'", "''") & "'" & ""
cSQL22 = cSQL22 & "where Tab_Import.Num_Demande='" & Replace(strCellModifiee, "'", "''") & "'" & ";"
DoCmd.RunSQL cSQL22
Else
strCellModifiee = oWSht.Cells(i, NumDemNRef)
cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[Num128]='" & Replace(Code128$(strCellModifiee), "'", "''") & "'" & ""
cSQL22 = cSQL22 & "where Tab_Import.Num_Demande='" & Replace(strCellModifiee, "'", "''") & "'" & ";"
DoCmd.RunSQL cSQL22
End If
'Fin Code 128
i = i + 1
csql2 = "UPDATE [TAB_IMPORT] INNER JOIN [TAB_UG] ON [TAB_IMPORT].[UG_DEST] = [TAB_UG].[UG] SET [TAB_IMPORT].[ARMOIRE] = [TAB_UG].[ARMOIRE]"
csql2 = csql2 & "WHERE [TAB_IMPORT.UG_DEST]=[TAB_UG.UG];"
DoCmd.RunSQL csql2
Wend
MsgBox ("Importation terminée ")
'Edition Détail des Demandes
'Insertion totale dans TAB_IMPORT2"
c2SQL4 = "insert into [TAB_IMPORT2] "
c2SQL4 = c2SQL4 & "SELECT * from TAB_IMPORT; "
DoCmd.RunSQL c2SQL4
'MDM
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.MDM*' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'MDM ' where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.MDM*' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'MDM ' "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4444 = "delete from [TAB_IMPORT2] "
cSQL4444 = cSQL4444 & "where [TAB_IMPORT2].[SALLE]= 'MDM ' ;"
DoCmd.RunSQL cSQL4444
DoCmd.Requery
'NT
c3SQL5 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL5 = c3SQL5 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL5 = c3SQL5 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE '*NT*' "
c3SQL5 = c3SQL5 & "group by TAB_IMPORT2.UG_DEST"
c3SQL5 = c3SQL5 & ";"
DoCmd.RunSQL c3SQL5
DoCmd.Requery
cSQL445 = "update [TAB_IMPORT2] "
cSQL445 = cSQL445 & "set[TAB_IMPORT2].[SALLE]= 'Non Trouvés ' where TAB_IMPORT2.EMPLACEMENT LIKE '*NT*' "
cSQL445 = cSQL445 & ";"
DoCmd.RunSQL cSQL445
cSQL4445 = "update [TAB_COUNT_UG2] "
cSQL4445 = cSQL4445 & "set[TAB_COUNT_UG2].[SALLE]= 'Non Trouvés ' "
cSQL4445 = cSQL4445 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4445 = cSQL4445 & ";"
DoCmd.RunSQL cSQL4445
cSQL4446 = "delete from [TAB_IMPORT2] "
cSQL4446 = cSQL4446 & "where [TAB_IMPORT2].[SALLE]= 'Non Trouvés ' ;"
DoCmd.RunSQL cSQL4446
DoCmd.Requery
'Non référencés
c3SQL6 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL6 = c3SQL6 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL6 = c3SQL6 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE 'TAMPON_SPARK' or TAB_IMPORT2.EMPLACEMENT=' ' "
c3SQL6 = c3SQL6 & "group by TAB_IMPORT2.UG_DEST"
c3SQL6 = c3SQL6 & ";"
DoCmd.RunSQL c3SQL6
cSQL446 = "update [TAB_IMPORT2] "
cSQL446 = cSQL446 & "set[TAB_IMPORT2].[SALLE]= 'Non Référencés ' where TAB_IMPORT2.EMPLACEMENT LIKE 'TAMPON_SPARK' or TAB_IMPORT2.EMPLACEMENT=' ' "
cSQL446 = cSQL446 & ";"
DoCmd.RunSQL cSQL446
cSQL4445 = "update [TAB_COUNT_UG2] "
cSQL4445 = cSQL4445 & "set[TAB_COUNT_UG2].[SALLE]= 'Non Référencés ' "
cSQL4445 = cSQL4445 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4445 = cSQL4445 & ";"
DoCmd.RunSQL cSQL4445
cSQL4446 = "delete from [TAB_IMPORT2] "
cSQL4446 = cSQL4446 & "where [TAB_IMPORT2].[SALLE]= 'Non Référencés ' ;"
DoCmd.RunSQL cSQL4446
DoCmd.Requery
'VH,WS & MZ
c3SQL7 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL7 = c3SQL7 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL7 = c3SQL7 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.VH*' or TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.WS*' "
c3SQL7 = c3SQL7 & "or TAB_IMPORT2.EMPLACEMENT Like 'BCA.MZ*' "
c3SQL7 = c3SQL7 & "group by TAB_IMPORT2.UG_DEST"
c3SQL7 = c3SQL7 & ";"
DoCmd.RunSQL c3SQL7
cSQL447 = "update [TAB_IMPORT2] "
cSQL447 = cSQL447 & "set[TAB_IMPORT2].[SALLE]= 'VH,WS & MZ ' where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.VH*' or TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.WS*' "
cSQL447 = cSQL447 & "or TAB_IMPORT2.EMPLACEMENT Like 'BCA.MZ*' "
cSQL447 = cSQL447 & ";"
DoCmd.RunSQL cSQL447
cSQL4445 = "update [TAB_COUNT_UG2] "
cSQL4445 = cSQL4445 & "set[TAB_COUNT_UG2].[SALLE]= 'VH,WS & MZ ' "
cSQL4445 = cSQL4445 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4445 = cSQL4445 & ";"
DoCmd.RunSQL cSQL4445
cSQL4446 = "delete from [TAB_IMPORT2] "
cSQL4446 = cSQL4446 & "where [TAB_IMPORT2].[SALLE]= 'VH,WS & MZ ' ;"
DoCmd.RunSQL cSQL4446
DoCmd.Requery
'EV
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'EV.EV' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'EV' where TAB_IMPORT2.EMPLACEMENT = 'EV' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'EV' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'EV' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'PEL SIM
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'PEL SIM' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'PEL SIM' where TAB_IMPORT2.EMPLACEMENT = 'PEL SIM' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'PEL SIM' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'PEL SIM' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'HL SIM CARDIO
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'HL SIM CARDIO' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'HL SIM CARDIO' where TAB_IMPORT2.EMPLACEMENT = 'HL SIM CARDIO' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'HL SIM CARDIO' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'HL SIM CARDIO' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'Transferts
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'BCA.TRANSFERTS' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'HL SIM CARDIO' where TAB_IMPORT2.EMPLACEMENT = 'BCA.TRANSFERTS' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'BCA.TRANSFERTS' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'BCA.TRANSFERTS' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'A REMETTRE Call EditerDetDem 'Edition Détail des Demandes
MsgBox ("Edition Détails des Demandes en cours... ")
oApp.Quit 'Appli Excel
' Libère la mémoire des Objets oWSht,oWkb,oApp
Set oWSht = Nothing 'feuille de calcul libère le pointeur
Set oWkb = Nothing 'Classeur libère le pointeur
Set oApp = Nothing 'libère le pointeur
DoCmd.OpenForm "Formulaire_VISU_IMPORT"
FinGes_err:
Exit Sub
Ges_Err:
If err.Number = 3340 Then
Resume Next
Else
MsgBox err.Description
Resume Next
End If
End Sub |
Partager