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
| 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
' 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
'Fermer le classeur sans l'enregistrer
wbk.Close False
Set wbk = Nothing
' Quitter Excel
xl.Quit
Set xl = Nothing
MsgBox "La feuille S1 " & "." & Annee & " existe deja.", vbInformation
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 12_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
' Supprime définitions de requêtes autres que TQName
SupprLiaisonsTQ wbk, TQName
' Demarre la requete ajout
DoCmd.RunMacro "M3 Horrairemystere.Rempliossage horraire disvié"
' Création requête Excel
Set xlQryTbl = wbk.ActiveSheet.QueryTables.Add(sODBCconn, wbk.ActiveSheet.Range("A3"))
'Paramétrage requête Excel
With xlQryTbl
.CommandText = sSQL
.Name = TQName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
End With
' Exécute requête
xlQryTbl.Refresh False
xlSheet.Range("C1").Formula = "=INT(MOD(INT((C3)/7)+0.6,52+5/28))+1"
xlSheet.Range("C1").AutoFill xlSheet.Range("C1:GB1"), xlFillCopy
xlSheet.Range("C2").Formula = "=TEXT(C4, ""jjj"")"
xlSheet.Range("C2").AutoFill xlSheet.Range("C2:GB2"), xlFillCopy
wbk.Save
Set xlQryTbl = Nothing
Set xlSheet = Nothing
wbk.Close
Set wbk = Nothing
xl.Quit
Set xl = Nothing
End If
End Sub |
Partager