Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Extraction de données suivant onglets (msgbox)

GV91

XLDnaute Junior
Bonjour,

Ci-joint un code VBA me permettant une de faire une requête d'un fichier Excel source "AA", ce fichier source possédant 31 onglets soit un par jour.

Ici j'ai fait un test (concluant) sur le jour 2 (2$ en ligne 13), mon problème est que j'aimerai avoir une msgbox me permettant de modifier ce chiffre suivant le jour que je veux dans mon fichier source "AA"

Je n'arrive pas à incorporer ce paramètre dans mon code.

D'avance merci pour toute collaboration.


Sub Macro2()
'
' Macro2 Macro
'

'
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Users\Gravina.A\Desktop\test pour connexion\Suivi mouvements stock\2020\AA.xlsm;DefaultDir=C:\Users\Grav" _
), Array( _
"ina.A\Desktop\test pour connexion\Suivi mouvements stock\2020;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("$A$3")).QueryTable
.CommandText = Array( _
"SELECT `'2$'`.Date, `'2$'`.Emplacement, `'2$'`.Motif" & Chr(13) & "" & Chr(10) & "FROM `'2$'` `'2$'`")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files"
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-27
ActiveSheet.ListObjects("Tableau_Lancer_la_requête_à_partir_de_Excel_Files"). _
Range.AutoFilter Field:=3, Criteria1:="8 Casse entrepôt"
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Add Key _
:=Range( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files[[#All],[Emplacement]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour

Vous pouvez toujours essayer les lignes ci-dessous.
sans fichier difficile de tester plus avant.
VB:
Sub Macro2()
'
' Macro2 Macro
'

'
Const SQL_Base As String = "SELECT `'2$'`.Date, `'2$'`.Emplacement, `'2$'`.Motif FROM `'2$'` AS `'2$'`;"
Dim SQL As String
Dim rep As Variant
rep = Application.InputBox("Entrez le numéro de jour désiré", "Interrogation base de données", 0, Type:=1)

If rep <> False And rep >= 1 And rep <= 31 Then SQL = Replace(SQL_Base, "2", CStr(rep))

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Users\Gravina.A\Desktop\test pour connexion\Suivi mouvements stock\2020\AA.xlsm;DefaultDir=C:\Users\Grav" _
), Array( _
"ina.A\Desktop\test pour connexion\Suivi mouvements stock\2020;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("$A$3")).QueryTable
.CommandText = Array(SQL)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files"
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-27
ActiveSheet.ListObjects("Tableau_Lancer_la_requête_à_partir_de_Excel_Files"). _
Range.AutoFilter Field:=3, Criteria1:="8 Casse entrepôt"
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort.SortFields.Add Key _
:=Range( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files[[#All],[Emplacement]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Excel_Files").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
 

Discussions similaires

Réponses
4
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…