OVH Cloud OVH Cloud

ameloration de ce code

11 réponses
Avatar
Cyr73
Bonjour à tous,
spécialement à Isabelle auprès de qui je m'excuse, mon fichier est trop
volumineux
pour cjoint.

je vous sollicite encore, voici mon problème je voudrais rajouter à ce code
qui
recherche si il y a une valeur numerique dans le jour choisi ,de continuer
la procedure que si la valeur de la colone A sur la même ligne
est différente de rien
merci

Sub Imprimer_Feuille_Livraison()
Dim c As Range, ResAdr As String
rep = InputBox("Entrez une date au Format 01/01")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs REPAS")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
Set c = Intersect(.Columns(col), .Rows("5:60000")).Find("*")
If Not c Is Nothing Then
On Error Resume Next
ResAdr = c.Address
Do
Err.Clear
ligne = c.Row
Feuille = .Cells(ligne, 2)
Sheets(Feuille).Select
[J11:K11].AutoFilter
[J11:K11].AutoFilter Field:=2, Criteria1:="1"
Attente (500)
Var = Err.Number
Sheets(Feuille).PrintOut Copies:=2, Collate:=True
[J11:K11].AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "la Feuille de Livraison de ce client n'existe Pas
!!" & .Cells(ligne, 1)
End If
Set c = Intersect(.Columns(col), .Rows("5:60000")).FindNext(c)
Loop While Not c Is Nothing And c.Address <> ResAdr
On Error GoTo 0
End If
End If
End With
End If
End Sub

--
Cordialement

et avec tout mes remerciements..

1 réponse

1 2
Avatar
Cyr73
Bonjour Michdenis,

c'est tout bonnement royal un grand merci pour ta patience et ton savoir
faire.
--
Cordialement

et avec tout mes remerciements..


"michdenis" a écrit :

Essaie ceci :

http://cjoint.com/?jmbh7qx212



"Cyr73" a écrit dans le message de groupe de discussion
:
merci encore
le fichier sous les yeux vaudra toutes mes expliquations

http://cjoint.com/?jmaPtHJlwx
--
Cordialement

et avec tout mes remerciements..


"Cyr73" a écrit :

> je comprend c'est clair pour moi car j'ai le fichier...
>
> voici comment se présente la feuille.
>
> colonne a(le nom du livreur) /colonne b(le nom du client) / ensuite les
> jours du mois
> jean les pervenches
> 80 (repas)
> mon shouait recherche le jour via inputbox, si il y a 1 chiffre (nombre de
> repas) sur la ligne de ce client, regarde si il y a un nom de livreur si les
> deux condition sont
> remplies imprime....
> mon fichier ne passe pas sur cjoint !
> merci de ton interet a mon probleme.
> --
> Cordialement
>
> et avec tout mes remerciements..
>
>
> "michdenis" a écrit :
>
> > | mais cela imprime la feuille meme si il ni a pas de valeur en
> > | colonne A. j'aurais aimer que si il y a un chiifre correspondant
> > | au client dans la date voulue qu'il regarde que sur la meme
> > | ligne en colonne A il y ai un nom de chauffeur.
> >
> > Je n'ai pas ton classeur sous les yeux !
> >
> > Où se trouve le numéro du client ? Dans quelle feuille, adresse de cellule ...?
> > Lorsque tu parles de la colonne A:A, c'est sur la même ligne du Set C...?
> >
> > Ton information est trop vague ! Précise si tu veux de l'aide !
> >
> >
> >
> >
> > "Cyr73" a écrit dans le message de groupe de
> > discussion
> > :
> > Oups je viens de voir l'erreure mon fichier à changer
> > les feuille3 ne correspond plus à la feuille d'effectif (j'ai corriger)
> > mais cela imprime la feuille meme si il ni a pas de valeur en
> > colonne A.
> > j'aurais aimer que si il y a un chiifre correspondant au client dans la date
> > voulue
> > qu'il regarde que sur la meme ligne en colonne A il y ai un nom de chauffeur.
> > merci
> > --
> > Cordialement
> >
> > et avec tout mes remerciements..
> >
> >
> > "Cyr73" a écrit :
> >
> > > désolé, mais cela ne marche pas il ne se passe plus rien
> > > après la saisie de la date ?
> > > j'ai bien excel 2000.
> > > --
> > > Cordialement
> > >
> > > et avec tout mes remerciements..
> > >
> > >
> > > "michdenis" a écrit :
> > >
> > > > Désolé, c'est vrai, dans le message précédent, il manquait une ligne de code:
> > > >
> > > > Voici la procédure corrigée : X = Split(Rep, "/")
> > > > la fonction split() requiert une version Excel 2000 ou plus récent
> > > >
> > > > '-------------------------------------------
> > > > Sub Imprimer_Feuille_Livraison()
> > > > Dim C As Range, ResAdr As String, Rep As Variant
> > > > Dim X As Variant, MaDate As Long, T As Double
> > > >
> > > > Rep = InputBox("Entrez une date au Format jour / Mois ")
> > > > If Rep = "" Then Exit Sub
> > > >
> > > > On Error Resume Next
> > > > X = Split(Rep, "/")
> > > > MaDate = CLng(DateSerial(Year(Date), X(1), X(0)))
> > > > If Err <> 0 Then
> > > > MsgBox "Le format date n'a pas été respecté." & _
> > > > vbCrLf & "Opération annulée", vbCritical + _
> > > > vbOKOnly, "Attention."
> > > > Exit Sub
> > > > End If
> > > >
> > > > With Feuil3 ' Sheets("effectifs REPAS")
> > > > col = Application.Match(MaDate, .[C4:AG4], 0)
> > > > If IsNumeric(col) Then
> > > > col = col + 2
> > > > Set C = Intersect(.Columns(col), .Rows("5:60000")).Find("*")
> > > > If Not C Is Nothing Then
> > > > On Error Resume Next
> > > > ResAdr = C.Address
> > > > Do
> > > > Err.Clear
> > > > ligne = C.Row
> > > > Feuille = .Cells(ligne, 2)
> > > > Sheets(Feuille).Select
> > > > [J11:K11].AutoFilter
> > > > [J11:K11].AutoFilter Field:=2, Criteria1:="1"
> > > > ' Attente (500)
> > > > Var = Err.Number
> > > > Sheets(Feuille).PrintOut Copies:=2, Collate:=True
> > > > [J11:K11].AutoFilter
> > > > ' Attente (500)
> > > > If Err.Number <> 0 Then
> > > > Err.Clear
> > > > MsgBox "la Feuille de Livraison de ce client n'existe Pas !" &
> > > > .Cells(ligne, 1)
> > > > End If
> > > > Set C = Intersect(.Columns(col), .Rows("5:60000")).FindNext(C)
> > > > Loop While Not C Is Nothing And C.Address <> ResAdr
> > > > On Error GoTo 0
> > > > End If
> > > > End If
> > > > End With
> > > >
> > > > End Sub
> > > > '-------------------------------------------
> > > >
> > > >
> > > >
> > > > "Cyr73" a écrit dans le message de groupe de
> > > > discussion
> > > > :
> > > > Bonjour Michdenis,
> > > >
> > > > merci pour ta solution
> > > > j'ai copier le code dans workbook mais je suis
> > > > coincé par "le format de date n'a pas été respecté"
> > > > je rentre dans le inputbox "17/09" et les cellules
> > > > de date sur la feuille "effectifs Repas" sont au format "Jeudi 17"
> > > > merci
> > > > --
> > > > Cordialement
> > > >
> > > > et avec tout mes remerciements..
> > > >
> > > >
> > > > "michdenis" a écrit :
> > > >
> > > > > Bonjour Cyr79,
> > > > >
> > > > > J'ai seulement modifié le début de la procédure.
> > > > > J'ai présumé que les dates de la plage [C4:AG4] étaient
> > > > > des dates de l'année en cours.
> > > > >
> > > > > '----------------------------------------------
> > > > > Sub Imprimer_Feuille_Livraison()
> > > > > Dim C As Range, ResAdr As String, Rep As Variant
> > > > > Dim X As Variant, MaDate As Long, T As Double
> > > > >
> > > > > Rep = InputBox("Entrez une date au Format jour / Mois ")
> > > > > If Rep = "" Then Exit Sub
> > > > >
> > > > > On Error Resume Next
> > > > > MaDate = CLng(DateSerial(Year(Date), X(1), X(0)))
> > > > > If Err <> 0 Then
> > > > > MsgBox "Le format date n'a pas été respecté." & _
> > > > > vbCrLf & "Opération annulée", vbCritical + _
> > > > > vbOKOnly, "Attention."
> > > > > Exit Sub
> > > > > End If
> > > > >
> > > > > With Sheets("effectifs REPAS")
> > > > > col = Application.Match(MaDate, .[C4:AG4], 0)
> > > > > If IsNumeric(col) Then
> > > > > col = col + 2
> > > > > Set C = Intersect(.Columns(col), .Rows("5:60000")).Find("*")
> > > > > If Not C Is Nothing Then
> > > > > On Error Resume Next
> > > > > ResAdr = C.Address
> > > > > Do
> > > > > Err.Clear
> > > > > ligne = C.Row
> > > > > Feuille = .Cells(ligne, 2)
> > > > > Sheets(Feuille).Select
> > > > > [J11:K11].AutoFilter
> > > > > [J11:K11].AutoFilter Field:=2, Criteria1:="1"
> > > > > Attente (500)
> > > > > Var = Err.Number
> > > > > Sheets(Feuille).PrintOut Copies:=2, Collate:=True
> > > > > [J11:K11].AutoFilter
> > > > > Attente (500)
> > > > > If Err.Number <> 0 Then
> > > > > Err.Clear
> > > > > MsgBox "la Feuille de Livraison de ce client n'existe Pas !" &
> > > > > .Cells(ligne, 1)
> > > > > End If
> > > > > Set C = Intersect(.Columns(col), .Rows("5:60000")).FindNext(C)
> > > > > Loop While Not C Is Nothing And C.Address <> ResAdr
> > > > > On Error GoTo 0
> > > > > End If
> > > > > End If
> > > > > End With
> > > > >
> > > > > End Sub
> > > > > '----------------------------------------------
> > > > >
> > > > > "Cyr73" a écrit dans le message de groupe de
> > > > > discussion
> > > > > :
> > > > > Bonjour à tous,
> > > > > spécialement à Isabelle auprès de qui je m'excuse, mon fichier est trop
> > > > > volumineux
> > > > > pour cjoint.
> > > > >
> > > > > je vous sollicite encore, voici mon problème je voudrais rajouter à ce code
> > > > > qui
> > > > > recherche si il y a une valeur numerique dans le jour choisi ,de continuer
> > > > > la procedure que si la valeur de la colone A sur la même ligne
> > > > > est différente de rien
> > > > > merci
> > > > >
> > > > > Sub Imprimer_Feuille_Livraison()
> > > > > Dim c As Range, ResAdr As String
> > > > > rep = InputBox("Entrez une date au Format 01/01")
> > > > > If IsDate(rep) Then
> > > > > rep = CDate(rep)
> > > > > With Sheets("effectifs REPAS")
> > > > > col = Application.Match(rep * 1, .[C4:AG4], 0)
> > > > > If IsNumeric(col) Then
> > > > > col = col + 2
> > > > > Set c = Intersect(.Columns(col), .Rows("5:60000")).Find("*")
> > > > > If Not c Is Nothing Then
> > > > > On Error Resume Next
> > > > > ResAdr = c.Address
> > > > > Do
> > > > > Err.Clear
> > > > > ligne = c.Row
> > > > > Feuille = .Cells(ligne, 2)
> > > > > Sheets(Feuille).Select
> > > > > [J11:K11].AutoFilter
> > > > > [J11:K11].AutoFilter Field:=2, Criteria1:="1"
> > > > > Attente (500)
> > > > > Var = Err.Number
> > > > > Sheets(Feuille).PrintOut Copies:=2, Collate:=True
> > > > > [J11:K11].AutoFilter
> > > > > Attente (500)
> > > > > If Err.Number <> 0 Then
> > > > > Err.Clear
> > > > > MsgBox "la Feuille de Livraison de ce client n'existe Pas
> > > > > !!" & .Cells(ligne, 1)
> > > > > End If
> > > > > Set c = Intersect(.Columns(col), .Rows("5:60000")).FindNext(c)
> > > > > Loop While Not c Is Nothing And c.Address <> ResAdr
> > > > > On Error GoTo 0
> > > > > End If
> > > > > End If
> > > > > End With
> > > > > End If
> > > > > End Sub
> > > > >
> > > > > --
> > > > > Cordialement
> > > > >
> > > > > et avec tout mes remerciements..
> > > > >


1 2