fenec
XLDnaute Impliqué
Bonjour le forum
Une fois de plus besoin de votre aide
J’utilise cette macro sous 2003 et elle fonctionne tres bien mais je rencontre un probleme au travail sous 2007 elle ne fonctionne plus
Elle bloque sur en rouge
D’avance merci de votre aide
Cordialement
Fenec
Sub Editer_Facture() '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
.LookIn = "C:\Users\Philippe\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))
Mavariable = ActiveWorkbook.Name
End If
Next Y
Else
Msg = MsgBox("Aucun fichier correspondant à la " & _
"recherche.", , "Désolé...")
End If
End If
End With
Range("E13:E17,I15,C20:C35,E20:E35,G20:G35,H20:H35,I37:I38,H40:H41,H43:H44").Select
For Each cel In Selection
cel.Copy
Windows("VF Menuiserie.xls").Activate
Sheets("Facture").Select
Range(cel.Address).Select
ActiveSheet.Paste
Next cel
Range("I13").Select
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' Activer le classeur trouvé
Windows(Mavariable).Activate
ActiveWorkbook.Close savechanges:=True
End Sub
Une fois de plus besoin de votre aide
J’utilise cette macro sous 2003 et elle fonctionne tres bien mais je rencontre un probleme au travail sous 2007 elle ne fonctionne plus
Elle bloque sur en rouge
D’avance merci de votre aide
Cordialement
Fenec
Sub Editer_Facture() '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
.LookIn = "C:\Users\Philippe\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))
Mavariable = ActiveWorkbook.Name
End If
Next Y
Else
Msg = MsgBox("Aucun fichier correspondant à la " & _
"recherche.", , "Désolé...")
End If
End If
End With
Range("E13:E17,I15,C20:C35,E20:E35,G20:G35,H20:H35,I37:I38,H40:H41,H43:H44").Select
For Each cel In Selection
cel.Copy
Windows("VF Menuiserie.xls").Activate
Sheets("Facture").Select
Range(cel.Address).Select
ActiveSheet.Paste
Next cel
Range("I13").Select
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' Activer le classeur trouvé
Windows(Mavariable).Activate
ActiveWorkbook.Close savechanges:=True
End Sub