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
|
Option Compare Database
Private Sub Commande0_Click()
On Error GoTo Err_Commande0_Click
'################################## DECLARATION DES VARIABLES #####################################
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Set db = CurrentDb()
Dim i As Integer
Dim requete As String
Dim requete1 As String
Dim res As String
Dim res1 As String
Dim max As Integer
Dim REQnbRS As String
Dim REQnbLigne As String
Dim toto As Integer
'#################################### FIN DECLARATION #######################################
'#################################### NOMBRE DE REPRENTANTS #################################
REQnbRS = ("SELECT Count(Représentant.CodeReprésentant) AS NbReprésentant FROM Représentant")
Set rst1 = db.OpenRecordset(REQnbRS)
max = rst1("NbReprésentant")
'################################### FIN NOMBRE DE REPRESENTANTS ############################
'################################### BOUCLE SUR LES RS ######################################
For i = 1 To 5 'max
'################## OUVERTURE DU FICHIER COMMISSION.XLS ##########################################
'Déclaration des variables
Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
'Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open("Z:\COMMON\DDI\Departement Clientele\Commission\Commission.xls")
'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)
appExcel.Visible = False
'################### FIN CREATION ################################################
requete = "SELECT NomReprésentant FROM Représentant WHERE Numéro = " & i
Set rst = db.OpenRecordset(requete)
'############################# DEBUT DE LA REQUETE ################################
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=Z:\COMMON\DDI\Departement Clientele\Listing\Listing France 2006.mdb;DriverId=25;FIL=MS Access;MaxBuf" _
), Array("ferSize=2048;PageTimeout=5;")), Destination:=Range("A6"))
.CommandText = Array( _
"SELECT ReqTest.CodePointDeVente, ReqTest.NomClient, ReqTest.CP, ReqTest.AdresseClient" & Chr(13) & "" & Chr(10) & "FROM `Z:\COMMON\DDI\Departement Clientele\Listing\Listing France 2006`.ReqTest ReqTest" & Chr(13) & "" & Chr(10) & "WHERE (ReqTest.CP=" & toto & ")" _
)
.Name = "Lancer la requête à partir de MS Access Database_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=False
End With
'############################## FIN DE LA REQUETE ############################################
'requete1 = "SELECT F10 FROM a_Strator WHERE F10 =" & rst
'Set rst = db.OpenRecordset(requete1)
res = rst("NomReprésentant")
'Sheets("Feuil1").Evaluate ("B3")
Range("B3").Select
ActiveCell.FormulaR1C1 = res
Columns("B:B").EntireColumn.AutoFit
'SAUVERGADE DES FICHIERS
wbExcel.SaveAs ("Z:\COMMON\DDI\Departement Clientele\Commission\" & res & ".xls")
wbExcel.Close 'Fermeture du classeur Excel
appExcel.Quit 'Fermeture de l'application Excel
'Désallocation mémoire
Set wsExcel = Nothing
Set wbExcel = Nothing
Set appExcel = Nothing
Next
'MsgBox ("C fini !!")
Exit_Commande0_Click:
Exit Sub
Err_Commande0_Click:
MsgBox Err.Description
Resume Exit_Commande0_Click
End Sub |
Partager