recherche des données

Re : recherche des données

Bonjour le forum

Je relance ma discussion n’ayant toujours pas trouver la solution

Grace à l’enregistreur de macro je suis arrivé un faire un code pour éditer ma facture qui fonctionne sur un classeur
De la, à force de chercher j’ai trouvé ceci afin de pouvoir choisir le fichier à ouvrir :

Dim Fichier_Travail As String, Fichier As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
ChDir "C:\Users\Philippe\Documents\Archives\Bon de Commande"
Fichier = Application.GetOpenFilename(", *xlWindows", 0, "Sélectionner le nom")


Et c’est la que viens mon problème
Mon code ne marche plus
Vous joint mon fichier qui est plus explicite

Suis à l’écoute de toute proposition

Re : recherche des données

bonsoir
voici un exemple de code à tester
Sub Ouvrircertainsfichiers()
' Ouvrir des fichiers spécifiques
Dim Recf, Compar, Y, Msg
Set Recf = Application.FileSearch
With Recf
Compar = InputBox("Fichiers dont le nom commence par :" & _
Chr(13) & "(saisissez * pour obtenir tous les " & _
"classeurs du répertoire)", "Classeurs commençant par...")
If Compar <> "" Then
' ici le nom de ton répertoire, par ex.
' .LookIn = "c:\windows\bureau\monRépertoire"
.LookIn = ThisWorkbook.Path
.Filename = Compar & "*.*"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For Y = 1 To .FoundFiles.Count
If MsgBox("Voulez-vous ouvrir " & _
.FoundFiles(Y), vbYesNo) = vbYes Then
Workbooks.Open (.FoundFiles(Y))
End If
Next Y
Else
Msg = MsgBox("Aucun fichier correspondant à la " & _
"recherche.", , "Désolé...")
End If
End If
End With
End Sub
Cordialement
flyonets

Re : recherche des données

bonjour le forum et flyonets44

viens de tester ton code qui fonctionne tres bien mais le problème que je rencontre est que je ne sais pas intégrer mon code en fonction du fichier ouvert

merci déja pour ton code qui m'avance un peu

cordialement

fenec

Re : recherche des données

re,

viens d'essayer comme ceci mais je bloque sur :ActiveSheet.Paste
je pense que cela viens des cellules Q15:R15 qui sont fusionnées et qui contiennent une validation,si oui y a t il un moyen de contourner ce probleme

Sub Editer_Facture()

Application.ScreenUpdating = False
Application.ScreenUpdating = True
Dim Recf, Compar, Y, Msg
Set Recf = Application.FileSearch
With Recf
Compar = InputBox("Fichiers dont le nom commence par :" & _
Chr(13) & "(saisissez * pour obtenir tous les " & _
"classeurs du répertoire)", "Classeurs commençant par...")
If Compar <> "" Then
' ici le nom de ton répertoire, par ex.
' .LookIn = "c:\windows\bureau\monRépertoire"
.LookIn = "C:\Users\Philippe\Documents\Archives\Bon de Commande" 'ThisWorkbook.Path
.Filename = Compar & "*.*"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For Y = 1 To .FoundFiles.Count
If MsgBox("Voulez-vous ouvrir " & _
.FoundFiles(Y), vbYesNo) = vbYes Then
Workbooks.Open (.FoundFiles(Y))
End If
Next Y
Else
Msg = MsgBox("Aucun fichier correspondant à la " & _
"recherche.", , "Désolé...")
End If
End If
End With
Range("E13:E17,G16,J16,Q15:R15,C21:Q36,R38:R39,P41:R42,Q44:R45").Select
For Each cel In Selection
cel.Copy
Windows("Exemple.xls").Activate
Sheets("Facture").Select
Range("R13").Select
Range(cel.Address).Select
ActiveSheet.Paste
Next cel
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

cordialement

Re : recherche des données

Bonjour le forum
vous recontacte avec des infos supplémentaires au cas ou quelqu'un aurait une idée
en fait la macro fonctionne tres bien mais seulement sur les cellules simple,le problème vient de mes cellules fusionnées
est ce donc possible de contourner ce probleme

cordialement

fenec

Re : recherche des données

Bonsoir le forum

N’ayant pas eu de réponse à mon problème, j’ai essayé en alignant sur plusieurs cellules mais pas très esthétique alors j’ai modifié ma mise en page et supprimer mes cellules fusionnées et tout fonctionne très bien à présent sauf que je n’arrive pas à finaliser la macro pour que le fichier recherché se ferme automatiquement.

Vous remet la macro

Cordialement

Sub Editer_Facture()
Application.ScreenUpdating = False
Dim Recf, Compar, Y, Msg
Set Recf = Application.FileSearch
With Recf
Compar = InputBox("Fichiers dont le nom commence par :" & _
Chr(13) & "(saisissez * pour obtenir tous les " & _
"classeurs du répertoire)", "Classeurs commençant par...")
If Compar <> "" Then
.LookIn = "C:\Users\xxxxx\Documents\Archives\Bon de Commande"
.Filename = Compar & "*.*"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For Y = 1 To .FoundFiles.Count
If MsgBox("Voulez-vous ouvrir " & _
.FoundFiles(Y), vbYesNo) = vbYes Then
Workbooks.Open (.FoundFiles(Y))
End If
Next Y
Else
Msg = MsgBox("Aucun fichier correspondant à la " & _
"recherche.", , "Désolé...")
End If
End If
End With
Range("E13:E17,I15,C21:C36,E21:E36,G21:G36,H21:H36,I38:I39,H41:H42,H44:H45").Select
For Each cel In Selection
cel.Copy
Windows("exemple.xls").Activate
Sheets("Facture").Select
Range(cel.Address).Select
ActiveSheet.Paste
Next cel
Range("K13").Select
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub