Bonjour,
Toujours dans ma quête de résultats sous Excel, je cherche à faire excécuter 2 macros ensemble :
- une macro qui demande le fichier à importer
_ et une autre qui gère cette importation justement + mise en forme des données
J'active ces macros par un bouton
Voici les macros que j'utilise :
Macro ouverture de fichier
Sub ouvrirfichier()
Dim chemin As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers XLS", "*.xls"
If .Show = -1 Then
chemin = .SelectedItems(1) ' place le chemin du fichier dans la variable "chemin"
End If
End With
End Sub
Macro importation données dans onglet "Sheet3"
Sub TestQuery()
'si se trouve dans un dossier,alors :C:\NomDeMonDossier\Suivi_2005.xls
'si se trouve dans un dossier fils ,alors :C:\NomDeMonDossier\NomDeMonDossierFils\nomdefichier.xls
fich$ = "c:\Copie Export Télémaque Interface Gestionnaire 2007-1.xls"
Feuille$ = "2007"
QueryWorksheet fich, Feuille
End Sub
Public Sub QueryWorksheet(NomFichier$, Feuille$)
'Rob Bovey, mpep
'nécessite une référence à la librairie
'Microsoft ActiveX Data Object 2.x Library
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
''' Crée la chaîne de connexion
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=Excel 8.0;"
' La requête est basée sur le nom de la feuille. Ce nom
' doit se terminer par un $ et doit être entouré de crochets droits.
' Adapter ce nom à vos besoins
szSQL = "SELECT * FROM [" & Feuille & "$];"
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
''' Vérifie qu'on a bien reçu des données
If Not rsData.EOF Then
Sheets("CL").Range("A2").CopyFromRecordset rsData
Else
MsgBox "Aucun enregistrement renvoyé.", vbCritical
End If
''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing
'
'
' Convertit les données importées en données numériques
'
'
Sheets("CL").Select
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("J:J").Select
Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("A2").Select
End Sub
Je souhaiterai faire cohabiter (coupler) ses 2 macros via un seul bouton.
Merci d'avance pour votre aide précieuse.
Toujours dans ma quête de résultats sous Excel, je cherche à faire excécuter 2 macros ensemble :
- une macro qui demande le fichier à importer
_ et une autre qui gère cette importation justement + mise en forme des données
J'active ces macros par un bouton
Voici les macros que j'utilise :
Macro ouverture de fichier
Sub ouvrirfichier()
Dim chemin As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers XLS", "*.xls"
If .Show = -1 Then
chemin = .SelectedItems(1) ' place le chemin du fichier dans la variable "chemin"
End If
End With
End Sub
Macro importation données dans onglet "Sheet3"
Sub TestQuery()
'si se trouve dans un dossier,alors :C:\NomDeMonDossier\Suivi_2005.xls
'si se trouve dans un dossier fils ,alors :C:\NomDeMonDossier\NomDeMonDossierFils\nomdefichier.xls
fich$ = "c:\Copie Export Télémaque Interface Gestionnaire 2007-1.xls"
Feuille$ = "2007"
QueryWorksheet fich, Feuille
End Sub
Public Sub QueryWorksheet(NomFichier$, Feuille$)
'Rob Bovey, mpep
'nécessite une référence à la librairie
'Microsoft ActiveX Data Object 2.x Library
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
''' Crée la chaîne de connexion
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=Excel 8.0;"
' La requête est basée sur le nom de la feuille. Ce nom
' doit se terminer par un $ et doit être entouré de crochets droits.
' Adapter ce nom à vos besoins
szSQL = "SELECT * FROM [" & Feuille & "$];"
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
''' Vérifie qu'on a bien reçu des données
If Not rsData.EOF Then
Sheets("CL").Range("A2").CopyFromRecordset rsData
Else
MsgBox "Aucun enregistrement renvoyé.", vbCritical
End If
''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing
'
'
' Convertit les données importées en données numériques
'
'
Sheets("CL").Select
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("J:J").Select
Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("A2").Select
End Sub
Je souhaiterai faire cohabiter (coupler) ses 2 macros via un seul bouton.
Merci d'avance pour votre aide précieuse.