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
| Private Sub Commande1_Click()
Dim TQName As String
Dim xlQryTbl As Excel.QueryTable
Dim sODBCconn As String, sSQL As String
Dim xl As Excel.Application
Dim wbk As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Annee As Variant
Dim NomFichier As Variant
Annee = Me![Num Année]
NomFichier = "2onglets.xls"
If Me.Dirty Then
DoCmd.RunCommand acCmdSaveRecord
End If
' Demarre la requete ajout
DoCmd.RunMacro "M3 Horrairemystere.Rempliossage horraire disvié"
' Démarrer Excel et le rendre visible
Set xl = CreateObject("Excel.Application")
Set wbk = xl.Workbooks.Open("C:\" & NomFichier, 0)
xl.Visible = True
'On Error Resume Next
xl.UserControl = True
' Test de l'existence d'une feuille
If FeuilleExiste(wbk, "S1 " & "." & Annee & " ") Then
MsgBox "La feuille S1 " & "." & Annee & " existe deja.", vbInformation
'Fermer le classeur sans l'enregistrer
wbk.Close False
Set wbk = Nothing
' Quitter Excel
xl.Quit
Set xl = Nothing
Else
' Créer une nouvelle feuille après la dernière feuille
Set xlSheet = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
xlSheet.Name = "S1 " & "." & Annee & " "
xlSheet.Activate
' Chaîne de connexion ODBC
sODBCconn = "ODBC;DSN=MS Access Database;" & _
"DBQ=d:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 05a_08.mdb"
' Code SQL de la requête
sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]='MAN',1,IIf([R_QueryTableaupresent 1S].[Expr1]='TECH',2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]='M',1,IIf([R_QueryTableaupresent 1S].[Horaire1]='S',2,3));"
' Nom requête Excel
TQName = "TQ_" & "S1" & "_" & Annee
' Création requête Excel
Set xlQryTbl = wbk.ActiveSheet.QueryTables.Add(sODBCconn, wbk.ActiveSheet.Range("B6"))
'Paramétrage requête Excel
With xlQryTbl
.CommandText = sSQL
.Name = TQName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 1
.PreserveColumnInfo = True
End With
' Exécute requête
xlQryTbl.Refresh False
' Supprime définitions de requêtes autres que TQName
SupprLiaisonsTQ wbk, TQName
wbk.Save
Set xlQryTbl = Nothing
Set xlSheet = Nothing
wbk.Close
Set wbk = Nothing
xl.Quit
Set xl = Nothing
End If
End Sub |
Partager