Msgbox avec tous résultats de recherche si valeur pas trouvé
Résolu
bassmart
Messages postés
281
Date d'inscription
Statut
Membre
Dernière intervention
-
bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention -
bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention -
Bonjour le forum,
J'ai une macro avec à l'intérieure une requète SQL pour rechercher une valeur dans un fichier non ouvert (merci à Michel sur ce coup) qui fonctionne très bien. Lorsque la valeur recherché n'est pas trouvé, j'ai ajouté un "msgbox" pour avertir l'utilisateur que la valeur n'a pas été trouvé.
Le problème est que si je traite plusieurs fichiers en même temps, il l'affiche après le traitement de chacun des fichiers. Ce que je voudrais, c'est qu'il l'affiche seulement une fois à la fin du traitement de tout les fichiers. Encore mieux, je sortirais un genre de rapport ou de journal(style Word) avec tout les fichiers où que la valeur n'a pas été trouvé.
J'ai essayé à différent endroit dans mon code, mais sans succès.
Voici mon code qui se trouve dans un module:
Pouvez-vous m'aider?
J'ai une macro avec à l'intérieure une requète SQL pour rechercher une valeur dans un fichier non ouvert (merci à Michel sur ce coup) qui fonctionne très bien. Lorsque la valeur recherché n'est pas trouvé, j'ai ajouté un "msgbox" pour avertir l'utilisateur que la valeur n'a pas été trouvé.
Le problème est que si je traite plusieurs fichiers en même temps, il l'affiche après le traitement de chacun des fichiers. Ce que je voudrais, c'est qu'il l'affiche seulement une fois à la fin du traitement de tout les fichiers. Encore mieux, je sortirais un genre de rapport ou de journal(style Word) avec tout les fichiers où que la valeur n'a pas été trouvé.
J'ai essayé à différent endroit dans mon code, mais sans succès.
Voici mon code qui se trouve dans un module:
Option Explicit
'------------------------------------------------------------
Sub compter_dans_fermé()
Dim Source As Object, Requete As Object
Dim Prefix As String, Fichier2 As String, Table As String, texte_SQL As String
Dim i As Integer
Dim Msg As String
'initialisation
Msg = ""
'----------------------------------Initialisations
Prefix = ActiveSheet.Cells(2, "A")
If Prefix = "" Then
MsgBox "cellule vide", vbCritical, vbOKOnly
Exit Sub
End If
'Définit le classeur fermé servant de base de données
Fichier2 = "M:\Entrepot\BDFS\0_Sondages_a_saisir_Geotec\" & "SONDAGE.xlsx"
'Nom de la feuille dans le classeur fermé
Table = "SONDAGE" & "$"
' colonne de recherche
'Champ = "NO_SONDAGE"
'-----------------------------------connexion
Set Source = CreateObject("ADODB.connection")
With Source
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Fichier2 & ";Extended Properties=""Excel 12.0;HDR=YES;"""
.Open
End With
'--------------------------requete
Set Requete = CreateObject("ADODB.Recordset")
texte_SQL = "SELECT NO_SONDAGE FROM [" & Table & "]"
Set Requete = Source.Execute(texte_SQL)
'-------------------------restitution
With Requete
.MoveFirst
Do While Not .EOF
If .Fields(0) Like Prefix & "*" Then
ActiveSheet.Cells(2, "A") = .Fields(0)
i = 1
Exit Do
End If
.MoveNext
Loop
If i = 0 Then
Msg = Msg & "La valeur " & ActiveSheet.Cells(2, "A") & " n'as pas été trouvé dans la table «SONDAGE»" & Chr(10)
End If
End With
'Affichage du msgbox
If Msg <> "" Then
MsgBox Msg, vbExclamation, "Attention!!!"
End If
End Sub
Pouvez-vous m'aider?
3 réponses
-
Bonjour,
Justement, j'ai suivi les episodes a propos de la demande que vous aviez faites et que vous avez a la fin quand meme utilise le code de Michel_M.
J'avais d'ailleur fait un code sur votre fichier avec votre programmation de depart et en fin je fais un.CopyFromRecordset
au lieu d'une boucle pour trouver le ou les bons numeros, petite question: etes-vous sure qu'il n'y a qu'un seul sondage correspondant au numero mis au depart dans la cellule, car dans votre fichier exemple y a au un cas ou il y en a deux
C12003-004-08
C12003-004-09
et dans ce cas !!
C12096-004-12
C12096A-004-12
Plusieurs fichiers, ok, mais comment les recherchez-vous ?-
Bonjour,
Bon point, je n'y avais même pas pensé!!
J'ai fait le test et effectivement dans les 2 cas j'ai un problème! Si j'ai C28209A dans ma cellule de recherche, il me copie la valeur C28209-005-12 et non pas C28209A-005-12.
La façon que je recherche dans le classeur fermé, c'est avec la valeur qui est inscrite dans la cellule (A2) de mon fichier qui correspond à C28209A.
Comment faire pour corriger le problème? Est-ce qu'il y a un moyen de nous avertir qu'il a trouvé 2 valeurs correspondantes et de choisir laquelle on veut utiliser?
Est-ce que le.copyfromrecordset
serait une meilleur option?
Merci beaucoup!! -
Rebonjour,
Je résolu le problème pour les numéro comme C28209A, il y avais une petite erreur dans la retranscription du nom du classeur qui correspond à NO_SONDAGE à l'intérieur du classeur, il me tronquait le nom en enlevant le "A" de la fin.
Maintenant, ça fonctionne bien pour c'est cas!- Bonjour a tous,
un fichier avec les deux methodes de recherche et affichage, ne résout pas le probleme des msgbox, mais ceci est assez simple a resoudre
Dans "mon code" j'utilse une requete SQL avec un WHERE et LIKE
Nous reposons la meme question:
-Comment selectionnez-vous les fichiers a traiter et avec comment appelez-vous votre subroutineSub compter_dans_fermé()
- Pour sélectionner les classeurs, je l'ai sélectionnent à l'aide d'un Userform.
La façon dont j'appel la subroutine, j'utiliseCall compter_dans_fermé
Voici ma macro complète:Option Explicit Private Sub CommandButton1_Click() Dim QuelFichier() Dim Chemin, Fichier, Nomclasseur, strSONDAGE, Cible, Sondage, Value As String Dim DerLig, Lig, Dercol, Dercol2, NewDercol, DerLigS, DerLigF As Long Dim Prof, Prof2 As String Dim i, x, N, ligne, col, C, V, a As Integer Dim TInfos, nomfichier Dim celluletrouve, celluletrouve2, MaPlage As Range Dim Cn As ADODB.Connection Dim Fichier2 As String Dim NomFeuille As String, texte_SQL As String Dim Rst As ADODB.Recordset ChDrive "m" 'ChDir "M:\Temporaire\Martin D'Anjou\Travail nouveau formulaire\Test piézocône" ChDir "M:\Entrepot\BDFS\1_Données de forages et sondages\" 'On Error GoTo fin QuelFichier = Application.GetOpenFilename("Fichier excel(*.xls; *.xlsx),*.xls;*.xlsx", , , , True) If IsArray(QuelFichier) Then For i = LBound(QuelFichier, 1) To UBound(QuelFichier, 1) Workbooks.Open QuelFichier(i) '------------------------------------------- 'Nom de fichier SANS extention en partant du chemin complet Nomclasseur = Left(Mid(QuelFichier(i), InStrRev(QuelFichier(i), "\") + 1), Len(Mid(QuelFichier(i), InStrRev(QuelFichier(i), "\") + 1)) - 4) If Left(Nomclasseur, 1) <> "C" Then If InStr(Nomclasseur, "C") > 6 Then Nomclasseur = Mid(Nomclasseur, InStr((Nomclasseur), "C"), Len(Nomclasseur)) ElseIf Mid(Nomclasseur, 3, 2) = "cp" Or Mid(Nomclasseur, 3, 2) = "CP" Then Nomclasseur = "C" & Left(Nomclasseur, 2) & Mid(Nomclasseur, 5, Len(Nomclasseur) - 4) ElseIf Left(Nomclasseur, 1) = "c" Then Nomclasseur = "C" & Mid(Nomclasseur, 2, Len(Nomclasseur)) Else Nomclasseur = "C" & Nomclasseur End If End If '------------------------------------------- Application.ScreenUpdating = False 'traitement de chacune des feuilles ici '--------------------------------------- For x = 1 To Sheets.Count With Sheets(x) .Unprotect 'Trouver la valeur Depth dans la colonne A sinon on delete '---------------------------------------------------------- Prof = "depth" Set celluletrouve = Range("A1:D10").Find(Prof, lookat:=xlWhole) If celluletrouve Is Nothing Then Prof2 = "Profondeur" Set celluletrouve2 = Range("A1:D10").Find(Prof2, lookat:=xlPart) If celluletrouve2 Is Nothing Then MsgBox "Colonne DEPTH n'as pas été trouvé", vbCritical Cells(1, 1).Value = "PROF" Cells(1, 2).Value = "Qt" Cells(1, 3).Value = "Fs" Cells(1, 4).Value = "U" Else ligne = celluletrouve2.Row col = celluletrouve2.Column Cells(ligne + 1, col).EntireRow.Delete Cells(ligne, col).Value = "PROF" If col > 1 Then Range(Cells(1, 1), Cells(1, col - 1)).EntireColumn.Delete If ligne > 1 Then Range(Cells(1, 1), Cells(ligne - 1, 1)).EntireRow.Delete End If Else ligne = celluletrouve.Row col = celluletrouve.Column Cells(ligne + 1, col).EntireRow.Delete Cells(ligne, col).Value = "PROF" If col > 1 Then Range(Cells(1, 1), Cells(1, col - 1)).Columns.Delete If ligne > 1 Then Range(Cells(1, 1), Cells(ligne - 1, 1)).EntireRow.Delete End If 'On enlève les ligne vides du fichier '------------------------------------ Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete ' problème ici delete tout 'Ajout de NO_SITE et NO_SONDAGE au bout du tableau + changement de nom '----------------------------------------------------------------------- Dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column .Cells(1, Dercol + 1).Value = "NO_SITE" .Cells(1, Dercol + 2).Value = "NO_SONDAGE" Application.CutCopyMode = False Dercol2 = Cells(1, Cells.Columns.Count).End(xlToLeft).Column Range(Cells(1, 1), Cells(1, Dercol2)).NumberFormat = "General" nomfichier = Nomclasseur For N = 2 To Dercol2 Select Case .Cells(1, N).Value Case "Qt", "qt" .Cells(1, N).Value = "QT" Case "Pw", "U", "u" .Cells(1, N).Value = "U2" Case "Fs", "fs" .Cells(1, N).Value = "FS" Case "Temp" .Cells(1, N).Value = "TEMP" Case "NO_SITE" .Cells(2, N).Value = "6.02.06.MT.02." & Mid(Nomclasseur, 2, 2) & "000" .Cells(2, N).EntireColumn.AutoFit Case "NO_SONDAGE" .Cells(2, N).Value = Mid(Nomclasseur, 1, Len(Nomclasseur)) .Cells(1, N).EntireColumn.AutoFit N = Dercol2 'Case "Qc" '.Cells(1, N).Value = "QC" Case Else .Columns(N).Delete '.Cells(1, N).EntireColumn.Delete N = N - 1 End Select Next N .Columns(1).Insert NewDercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column For C = 3 To DerLig .Range(Cells(C, NewDercol - 1), Cells(C, NewDercol)).Value = .Range(Cells(2, NewDercol - 1), Cells(2, NewDercol)).Value Next C .Columns(NewDercol).Cut Destination:=Columns(1) End With Next x ' Spécifie le chemin du fichier à comparer '------------------------------------------- strSONDAGE = "M:\Entrepot\BDFS\0_Sondages_a_saisir_Geotec\" & "SONDAGE.xlsx" ' Vérifier que les fichiers A et B se trouvent dans le répertoire '---------------------------------------------------------------- If Dir(strSONDAGE) = "" Then MsgBox "Le fichier SONDAGE.xlsx est introuvables", vbCritical + vbOKOnly, "Problème de fichier..." Exit Sub End If 'Comparaison des deux fichiers '----------------------------- Call compter_dans_fermé 'Copier la valeur cherché sur toute la colonne '--------------------------------------------- DerLig = Range("B" & Rows.Count).End(xlUp).Row Dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column Cells(2, 1).Copy With Range(Cells(3, 1), Cells(DerLig, 1)) .PasteSpecial xlPasteValues End With Cells(2, Dercol).Copy With Range(Cells(3, Dercol), Cells(DerLig, Dercol)) .PasteSpecial xlPasteValues End With Chemin = CurDir & "\Transfert_Geotec\" If Dir(Chemin, vbDirectory) = "" Then MkDir "Transfert_Geotec" Fichier = Nomclasseur & "_Geotec" & ".csv" Else Chemin = CurDir & "\Transfert_Geotec\" Fichier = Nomclasseur & "_Geotec" & ".csv" End If With ActiveWorkbook Application.DisplayAlerts = False .SaveAs Filename:=Chemin & Fichier, FileFormat:=xlCSV, CreateBackup:=False, local:=True .Close Application.DisplayAlerts = True End With '------------------------------------------- Next i Else MsgBox "Annuler" End If UserForm1.Hide ThisWorkbook.Saved = True Application.ScreenUpdating = True UserForm2.Show Application.ScreenUpdating = True End Sub
-
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour, tu veux-dire que tu appelles plusieurs fois compter_dans_fermé(), et que tu veux afficher le message après le dernier appel?
comment se font les multiples appels à compter_dans_fermé()?
si tu veux créer un rapport, il suffit d'écrire Msg dans un fichier au lier de faire le MsgBox.-
Bonjour yg_be,
Oui, je peut appeler plusieurs fois compter_dans_fermé(), dans le cas ou je veux traiter plus d'un classeur à la fois.
Cette macro est placé dans un module qui fait partie d'une macro beaucoup plus grosse qui ouvre les classeurs sélectionnés, qui effectue la mise en page de chacun des classeurs et qui les sauvegardent sous un nouveau nom.
Si je sélectionne exemple 5 classeurs, il fait le traitement des 5 classeurs un à la fois en boucle.
Est-ce que tu veux dire que je dois changer la ligneMsgBox Msg, vbExclamation, "Attention!!!"
?
Merci!
-
-
Lorsque la valeur recherché n'est pas trouvé, j'ai ajouté un "msgbox" pour avertir l'utilisateur que la valeur n'a pas été trouvé.
JE TE SIGNALE QUE JE T'AI PROPOSE CE POINT DANS MES REPONSES :-(((
TON i=1 EST RIDICULE --
J'ai une macro avec à l'intérieure une requète SQL pour rechercher une valeur dans un fichier non ouvert (merci à Michel sur ce coup)
JE REGRETTE DE T'AVOIR AIDE
Michel-
Bonjour Michel,
Désolé te t'avoir offusqué, ce n'était pas le but! Ça fonctionnait très bien lorsque j'ouvre un seul fichier.
Mais lorsque j'ouvre exemple 5 fichiers en même temps (je les traitent un à la fois),si il ne trouve pas aucune des valeurs recherché il m'envoi 5 messages à la fin de chacun des fichiers.
Pour le i=1, tu as raison que c'est ridicule! J'assume que je ne suis pas un pro de la programmation VBA, je fais de mon mieux pour arriver au résultats voulu.
Encore désolé de t'avoir froissé!! -
-
-
Tu persistes et signes
ci dessous copie du post 19 que tu n'as pas dédaigné lire...
.....
peite modif à apporter pour signaler un échecWith Requete
.MoveFirst
Do While Not .EOF
test = .fields(0)
If .fields(0) Like Prefix & "*" Then
ActiveSheet.Cells(2, "A") = .fields(0)
Exit Sub
End If
.MoveNext
Loop
End With
'gestionnnaire erreur
MsgBox "Référénce cherchée: " & Cells(2, "A") & " introuvable.", vbCritical, vbOKOnly
End Sub
I ly a d'ailleurs beaucoup simple mais.... -
-
