Sub cmd_Extract_Click()
Dim Cnn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rst2 As New ADODB.Recordset
Dim Rst3 As New ADODB.Recordset
Dim Rst4 As New ADODB.Recordset
Dim Rst5 As New ADODB.Recordset
Dim Rst6 As New ADODB.Recordset
Dim DateDeb As String
Dim DateFin As String
Dim DateDeb1 As String
Dim DateFin1 As String
Dim StrSQL As String
Dim StrSQL2 As String
Dim StrSQL3 As String
Dim StrSQL4 As String
Dim StrSQL5 As String
Dim StrSQL6 As String
Dim Cpt As Long
Dim CptFld As Integer
Dim CptFld2 As Integer
Dim CptFld3 As Integer
Dim CptFld4 As Integer
Dim CptFld5 As Integer
Dim CptFld6 As Integer
'Calcul sur ordre
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Msg = "Voulez vous les progressions en Jours Constant?" ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Définit les boutons.
Title = "Message d'alerte " ' Définit le titre.
' Affiche le message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
ActiveWorkbook.Sheets("ACCUEIL").Cells(4, 2).Value = "JC" ' Effectue une action.
Else ' L'utilisateur a choisi Non.
ActiveWorkbook.Sheets("ACCUEIL").Cells(4, 2).Value = "PP" ' Effectue une action.
End If
On Error Resume Next
Cnn.ConnectionString = "driver={Microsoft ODBC for Oracle};server=***;uid=***;pwd=****"
Cnn.Open
If Cnn.State <> adStateOpen Then
Cnn.ConnectionString = "driver={Microsoft ODBC pour Oracle};server=***;uid=***;pwd=***"
Cnn.Open
If Cnn.State <> adStateOpen Then
MsgBox "Connexion Impossible"
On Error GoTo 0
Exit Sub
End If
End If
On Error GoTo 0
'N
Sheets("CastoCh_N").Select
ActiveWorkbook.Sheets("CastoCh_N").Range("G6:R30000").ClearContents
ActiveWorkbook.Sheets("CastoCh_N").Cells(6, 7).Select
'N-1
Sheets("CastoCh_N_1").Select
ActiveWorkbook.Sheets("CastoCh_N_1").Range("G6:R30000").ClearContents
ActiveWorkbook.Sheets("CastoCh_N_1").Cells(6, 7).Select
'Date N
DateDeb = InputBox("Date Début N (format:jj/mm/aaaa)", "", Format(Now() - 1, "dd/mm/yyyy"))
DateFin = InputBox("Date Fin N (format:jj/mm/aaaa)", "", Format(Now() - 1, "dd/mm/yyyy"))
ActiveWorkbook.Sheets("ACCUEIL").Cells(5, 4).Value = "'" & DateDeb
ActiveWorkbook.Sheets("ACCUEIL").Cells(6, 4).Value = "'" & DateFin
ActiveWorkbook.Sheets("ACCUEIL").Calculate
'Gestion erreur format date
If ActiveWorkbook.Sheets("ACCUEIL").Cells(8, 4).Value = "Vrai" Then
MsgBox "Erreur dans le format de la Date"
Sheets("Bench Mag").Select
Exit Sub
End If
'Date N-1
DateDeb1 = ActiveWorkbook.Sheets("ACCUEIL").Cells(7, 2).Value
DateFin1 = ActiveWorkbook.Sheets("ACCUEIL").Cells(8, 2).Value
'pour N
'magasin
Cpt = 1
StrSQL = ""
While ActiveWorkbook.Sheets("SQL").Cells(Cpt, 1) <> ""
StrSQL = StrSQL & ActiveWorkbook.Sheets("SQL").Cells(Cpt, 2) & " "
Cpt = Cpt + 1
Wend
'Secteur
' Cpt = 1
' StrSQL2 = ""
' While ActiveWorkbook.Sheets("SQL_Sect").Cells(Cpt, 1) <> ""
' StrSQL2 = StrSQL2 & ActiveWorkbook.Sheets("SQL_Sect").Cells(Cpt, 2) & " "
' Cpt = Cpt + 1
' Wend
'ss_Secteur
' Cpt = 1
' StrSQL3 = ""
' While ActiveWorkbook.Sheets("SQL_ss_Sect").Cells(Cpt, 1) <> ""
' StrSQL3 = StrSQL3 & ActiveWorkbook.Sheets("SQL_ss_Sect").Cells(Cpt, 2) & " "
' Cpt = Cpt + 1
' Wend
'pour N-1
'magasin
Cpt = 1
StrSQL4 = ""
While ActiveWorkbook.Sheets("SQL").Cells(Cpt, 1) <> ""
StrSQL4 = StrSQL4 & ActiveWorkbook.Sheets("SQL").Cells(Cpt, 2) & " "
Cpt = Cpt + 1
Wend
'Secteur
' Cpt = 1
' StrSQL5 = ""
' While ActiveWorkbook.Sheets("SQL_Sect").Cells(Cpt, 1) <> ""
' StrSQL5 = StrSQL5 & ActiveWorkbook.Sheets("SQL_Sect").Cells(Cpt, 2) & " "
' Cpt = Cpt + 1
' Wend
'ss_Secteur
' Cpt = 1
' StrSQL6 = ""
' While ActiveWorkbook.Sheets("SQL_ss_Sect").Cells(Cpt, 1) <> ""
' StrSQL6 = StrSQL6 & ActiveWorkbook.Sheets("SQL_ss_Sect").Cells(Cpt, 2) & " "
' Cpt = Cpt + 1
' Wend
'Pour N
'Magasin
StrSQL = Replace(StrSQL, "#datechiffredeb#", DateDeb)
StrSQL = Replace(StrSQL, "#datechiffrefin#", DateFin)
'Secteur
'StrSQL2 = Replace(StrSQL2, "#datechiffredeb#", DateDeb)
' StrSQL2 = Replace(StrSQL2, "#datechiffrefin#", DateFin)
'Magasin
' StrSQL3 = Replace(StrSQL3, "#datechiffredeb#", DateDeb)
' StrSQL3 = Replace(StrSQL3, "#datechiffrefin#", DateFin)
'Pour N-1
'Magasin
StrSQL4 = Replace(StrSQL4, "#datechiffredeb#", DateDeb1)
StrSQL4 = Replace(StrSQL4, "#datechiffrefin#", DateFin1)
'Secteur
'StrSQL5 = Replace(StrSQL5, "#datechiffredeb#", DateDeb1)
' StrSQL5 = Replace(StrSQL5, "#datechiffrefin#", DateFin1)
'Magasin
' StrSQL6 = Replace(StrSQL6, "#datechiffredeb#", DateDeb1)
' StrSQL6 = Replace(StrSQL6, "#datechiffrefin#", DateFin1)
'Pour N
Sheets("CastoCh_N").Select
'ss_Secteur
Rst.Open StrSQL, Cnn
Cpt = 6
While Not Rst.EOF
For CptFld = 1 To Rst.Fields.Count
ActiveWorkbook.Sheets("CastoCh_N").Cells(Cpt, CptFld + 6) = Rst.Fields(CptFld - 1).Value
Next
Rst.MoveNext
Cpt = Cpt + 1
Wend
Rst.Close
'Secteur
' Rst2.Open StrSQL2, Cnn
' While Not Rst2.EOF
' For CptFld2 = 1 To Rst2.Fields.Count
' ActiveWorkbook.Sheets("CastoCh_N").Cells(Cpt, CptFld2 + 2) = Rst2.Fields(CptFld2 - 1).Value
' Next
' Rst2.MoveNext
' Cpt = Cpt + 1
' Wend
' Rst2.Close
'Ss secteur
' Rst3.Open StrSQL3, Cnn
' While Not Rst3.EOF
' For CptFld3 = 1 To Rst3.Fields.Count
' ActiveWorkbook.Sheets("CastoCh_N").Cells(Cpt, CptFld3 + 2) = Rst3.Fields(CptFld3 - 1).Value
' Next
' Rst3.MoveNext
' Cpt = Cpt + 1
' Wend
'Pour N-1
Sheets("CastoCh_N_1").Select
'ss_Secteur
Rst4.Open StrSQL4, Cnn
Cpt = 6
While Not Rst4.EOF
For CptFld4 = 1 To Rst4.Fields.Count
ActiveWorkbook.Sheets("CastoCh_N_1").Cells(Cpt, CptFld4 + 6) = Rst4.Fields(CptFld4 - 1).Value
Next
Rst4.MoveNext
Cpt = Cpt + 1
Wend
Rst4.Close
'Secteur
' Rst5.Open StrSQL5, Cnn
' While Not Rst5.EOF
' For CptFld5 = 1 To Rst5.Fields.Count
' ActiveWorkbook.Sheets("CastoCh_N_1").Cells(Cpt, CptFld5 + 2) = Rst5.Fields(CptFld5 - 1).Value
' Next
' Rst5.MoveNext
' Cpt = Cpt + 1
' Wend
' Rst5.Close
'Ss secteur
' Rst6.Open StrSQL6, Cnn
' While Not Rst6.EOF
' For CptFld6 = 1 To Rst6.Fields.Count
' ActiveWorkbook.Sheets("CastoCh_N_1").Cells(Cpt, CptFld6 + 2) = Rst6.Fields(CptFld6 - 1).Value
' Next
' Rst6.MoveNext
' Cpt = Cpt + 1
' Wend
'
' Rst6.Close
Cnn.Close
Sheets("Bench Mag").Select
ActiveWorkbook.Sheets("Bench MAG").Cells(1, 13).Value = "veuillez patienter pendant le recalcul des données ……."
ActiveWorkbook.Sheets("Bench MAG").Cells(2, 1).Value = 14
ActiveWorkbook.Sheets("Bench MAG").Cells(4, 1).Value = 5
ActiveWorkbook.Sheets("Bench MAG").Cells(6, 1).Value = 1
ActiveWorkbook.Sheets("Bench MAG").Cells(8, 1).Value = 1
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
'On Error Resume Next
'Selection.AutoFilter Field:=4
'Selection.AutoFilter Field:=5
'On Error Resume Next
'Selection.AutoFilter Field:=4, Criteria1:=1
ActiveWorkbook.Sheets("Bench MAG").Cells(1, 13).Value = ""
End Sub
