Récupération de données avec comparaison d'un champ

Option Explicit

Dim FileDir As String
Dim nom As String
Dim Filenumber As String
Const MotdePasse = "moustike"
Const FilePath = "C:\Documents and Settings\JEAN_MICHEL\Bureau\" '<<< Change this to your directory
Const FileOri = "C:\Documents and Settings\JEAN_MICHEL\Bureau\" '<<< Change this to your directory
'créer à la volée une boite de dialogue Excel 5 pour proposer plusieurs possibilités de choix

Sub ChoixOptions()

Dim i As Integer
Dim TopPos As Integer
Dim PrintDlg As DialogSheet
Dim cb As OptionButton
Dim Choix1, Choix2, Choix3
Dim ArrChoix As Variant
Dim ListMDP As Variant
Dim PaysChoix As Variant

Application.ScreenUpdating = False

' Ajoute une feuille de dialogue temporaire
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

' Ajoute les boutons d'option
ArrChoix = Array("", "Isaac", "Jenny", "Mission", "Moman", "Prabha", "Sandeep", "KALED", _
"PUSHPA", "AWENY", "KUMAR", "MING", "DENG JIE", "SUZAN", "DIAPENIE", "ANAND", "PAUL", "Bill")

TopPos = 40
For i = 1 To 17
PrintDlg.OptionButtons.Add 78, TopPos, 80, 16.5
PrintDlg.OptionButtons(i).Text = ArrChoix(i)
TopPos = TopPos + 14
Next i

' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 200

' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max(90, PrintDlg.DialogFrame.Top + TopPos - 24)
.Width = 200
.Caption = "Choisissez le Merchandiser"
End With

' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
PrintDlg.Show


' récupération du choix effectué
For i = 1 To 17
If PrintDlg.OptionButtons(i).Value = xlOn Then
Choix1 = PrintDlg.OptionButtons(i).Text

End If
Next
If Choix1 = "" Then
MsgBox "Aucun choix n'a été fait"

Else

' liste dans le même ordre des pays

PaysChoix = Array("", "INDEFF\", "Chine\", "Bangladesh\", "Bangladesh\", "INDEFF\", "Inde\", "Bangladesh\", _
"Bangladesh\", "Chine\", "Inde\", "Chine\", "Chine\", "Chine\", "Chine\", "Inde\", "Bangladesh\", "Chine\")

' liste dans le même ordre des mots de passe

ListMDP = Array("", "PRAT01W", "CCN03J", "SBD02P", "KBD02P", "PRAT01K", "KTI05S", "DBD02I", "YBD02P", "OCH10L", "KTI04K", "OHK06M", "OSH07D", "KCH08S", _
"KCH09A", "MUI11A", "WBD02L", "OCH12W")

Choix2 = PaysChoix(i)
Choix3 = ListMDP(i)

' Supprime la feuille de dialogue temporaire (sans message d'avertissement)

Application.DisplayAlerts = False
PrintDlg.Delete


' sauvegarde

Cells.EntireColumn.AutoFit
ActiveWorkbook.Save
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & Hour(Time) & " Heure " & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom

' Filtre sur le Merchandiser
Selection.AutoFilter Field:=4, Criteria1:=Choix1

' Efface les pages inutiles et les colonnes inutiles

Sheets(Array("Master", "Livres et Annules", "Liste dossiers", "Suivi Echantillons" _
, "Suivi Production", "Suivi Commissions")).Select
Sheets("Master").Activate
ActiveWindow.SelectedSheets.Delete


Columns("BJ:BY").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft



ActiveWindow.LargeScroll ToRight:=1
Range("X4").Select
Cells.EntireColumn.AutoFit

ActiveSheet.Protect Password:=MotdePasse, DrawingObjects:=False, Contents:=True, Scenarios:= _
True


FileDir = FilePath & Choix2 & Choix1 & ".xls"

'Saves file.
'-----------
'
SaveAs Filename:=FileDir, Password:=Choix3
Application.DisplayAlerts = True

Workbooks.Open FileOri & "SUIVI COMPLET" & ".xls"
Worksheets("General").Activate

Workbooks(Choix1 & ".xls").Close SaveChanges:=True

End If

End Sub

Cliquez pour agrandir...