Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

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..

10 réponses

1 2
Avatar
michdenis
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..
Avatar
Cyr73
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..



Avatar
michdenis
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..



Avatar
Cyr73
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..
>


Avatar
michdenis
Le bout de la macro que j'ai modifiée et proposée était celui-ci :

Je n'ai rien touché au de la de ce code..ni même ce que la macro
est sensée faire !
.
Si la procédure éprouve un problème, il faut d'abord que tu
nous dises ce que tu tentes de faire. Qu'est-ce que la macro est
supposé faire, quel est le résultat attendu ?



'*********************************************************************
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)
'*********************************************************************
Avatar
Cyr73
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..
> >


Avatar
michdenis
| 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..
> >


Avatar
Cyr73
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..
> > >


Avatar
Cyr73
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..
> > > >


Avatar
michdenis
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