Sub RecompilationdesEvenements()
Dim sfiltre As String
Dim STitre As String
Dim SNomDossier As String
Dim IntFilterIndex As Integer
Dim Filename As Variant
Dim StrNomduFichier As String
Dim StrDrive As String
Dim SData As String
Dim Wkb As Workbook
Dim Wouvert As String
sfiltre = ""
STitre = ""
SNomDossier = ""
IntFilterIndex = 0
Filename = ""
StrNomduFichier = ""
StrDrive = ""
SData = "\Data"
'http://www.tek-tips.com/faqs.cfm?fid=4114
'sfiltre = "Fichiers Excel (*.xls),*.xls;*.xlsx" 'Filtre à appliquer
sfiltre = "Fichiers office, *.xls;*.xlsx" 'Filtre à appliquer
'sfiltre = "Fichiers Excel (*.xls),*.xls" 'Filtre à appliquer
IntFilterIndex = 1
STitre = "Choisissez un fichier contenant les données à recompiler" 'Titre de la boite
SNomDossier = Application.ActiveWorkbook.Path 'Chemin initial
If Mid(SNomDossier, InStrRev(SNomDossier, "\"), Len(SNomDossier)) <> SData Then
SNomDossier = SNomDossier & "\Data"
End If
StrDrive = Mid(SNomDossier, 1, 1)
'On applique l'emplacement des fichiers.
ChDrive (StrDrive)
ChDir (SNomDossier)
With Application
' Set File Name to selected File
Filename = .GetOpenFilename(sfiltre, IntFilterIndex, STitre)
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
'On trouve le nom du fichier
StrNomduFichier = Mid(Filename, InStrRev(Filename, "\") + 1, Len(Filename))
If Filename = False Then
MsgBox "Pas de fichier sélectionné"
Exit Sub
End If
' Initialisation
Wouvert = False
' Parcours des classeurs ouverts
For Each Wkb In Workbooks
If Wkb.Name = StrNomduFichier Then
Wouvert = True
Exit For
End If
Next Wkb
If Wouvert = False Then
Call ouvrefichier(Filename)
' Open File
Workbooks.Open Filename
End If
'Permet de lancer une recompilation
Call GenerationdeBase(1, StrNomduFichier)
End Sub
'============================================
'============================================
Sub ouvrefichier(o_Filename)
On Error Resume Next
Workbooks.Open o_Filename
If Err.Number <> 0 Then
MsgBox "Il y a un problème à ouvrir ce fichier"
End
End If
MsgBox o_Filename, vbInformation, "Fichier ouvert avec succès!" ' This can be removed
End Sub