creation d'une macro par Daniel.C

Le
Cyr13
bonjour
ce message suite au code de Daniel.C
suite au test de la macro j ai decouvert un probleme
tout fonctionne bien pour le premier client mais on dirait qu elle plantedes
le deuxieme(probleme de boucle ??)
merci de l aide !!
ci joint le code que j ai adapter

Sub Imprimer_Feuille_Livraison()

rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
ligne = Intersect(.Columns(col), .Rows("5:60000")).Find("*").Row
On Error Resume Next
Feuille = .Cells(ligne, 2)
Sheets(Feuille).[J11:K11].Select
Sheets(Feuille).AutoFilter
Sheets(Feuille).AutoFilter Field:=2, Criteria1:="<>"
Attente (500)
Sheets(Feuille).PrintOut
Sheets(Feuille).AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet de ce client n'existe Pas !!" & .Cells(ligne,
1)
End If
End If
End With
End If
End Sub
-
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #5180371
Il n'y a pas de boucle. La macro n'imprime d'une feuille à la fois. J'ai
corrigé quelques erreurs. Modifie ton code comme suit :

Sub Imprimer_Feuille_Livraison()

rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
ligne = Intersect(.Columns(col), .Rows("5:60000")).Find("*").Row
On Error Resume Next
feuille = .Cells(ligne, 2)
[J11:K11].AutoFilter
[J11:K11].AutoFilter Field:=2, Criteria1:="<>"
Attente (500)
Sheets(feuille).PrintOut
[J11:K11].AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet de ce client n'existe Pas !!" & .Cells(ligne,
1)
End If
End If
End With
End If
End Sub
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub

Daniel
"Cyr13"
bonjour
ce message suite au code de Daniel.C
suite au test de la macro j ai decouvert un probleme
tout fonctionne bien pour le premier client mais on dirait qu elle
plantedes le deuxieme(probleme de boucle ??)
merci de l aide !!
ci joint le code que j ai adapter

Sub Imprimer_Feuille_Livraison()

rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
ligne = Intersect(.Columns(col), .Rows("5:60000")).Find("*").Row
On Error Resume Next
Feuille = .Cells(ligne, 2)
Sheets(Feuille).[J11:K11].Select
Sheets(Feuille).AutoFilter
Sheets(Feuille).AutoFilter Field:=2, Criteria1:="<>"
Attente (500)
Sheets(Feuille).PrintOut
Sheets(Feuille).AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet de ce client n'existe Pas !!" & .Cells(ligne,
1)
End If
End If
End With
End If
End Sub
-------------------------------------------------------
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub




Daniel.C
Le #5180361
Si j'ai mal compris et que pour la date entrée, il peut y avoir plusieurs
feuilles, fais-le moi savoir.
Daniel
"Cyr13"
bonjour
ce message suite au code de Daniel.C
suite au test de la macro j ai decouvert un probleme
tout fonctionne bien pour le premier client mais on dirait qu elle
plantedes le deuxieme(probleme de boucle ??)
merci de l aide !!
ci joint le code que j ai adapter

Sub Imprimer_Feuille_Livraison()

rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
ligne = Intersect(.Columns(col), .Rows("5:60000")).Find("*").Row
On Error Resume Next
Feuille = .Cells(ligne, 2)
Sheets(Feuille).[J11:K11].Select
Sheets(Feuille).AutoFilter
Sheets(Feuille).AutoFilter Field:=2, Criteria1:="<>"
Attente (500)
Sheets(Feuille).PrintOut
Sheets(Feuille).AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet de ce client n'existe Pas !!" & .Cells(ligne,
1)
End If
End If
End With
End If
End Sub
-------------------------------------------------------
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub




Xavier powaga
Le #5180351
Daniel au dodo
en tout cas moi j'y vais

"Daniel.C"
Si j'ai mal compris et que pour la date entrée, il peut y avoir plusieurs
feuilles, fais-le moi savoir.
Daniel
"Cyr13"
bonjour
ce message suite au code de Daniel.C
suite au test de la macro j ai decouvert un probleme
tout fonctionne bien pour le premier client mais on dirait qu elle
plantedes le deuxieme(probleme de boucle ??)
merci de l aide !!
ci joint le code que j ai adapter

Sub Imprimer_Feuille_Livraison()

rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
ligne = Intersect(.Columns(col), .Rows("5:60000")).Find("*").Row
On Error Resume Next
Feuille = .Cells(ligne, 2)
Sheets(Feuille).[J11:K11].Select
Sheets(Feuille).AutoFilter
Sheets(Feuille).AutoFilter Field:=2, Criteria1:="<>"
Attente (500)
Sheets(Feuille).PrintOut
Sheets(Feuille).AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet de ce client n'existe Pas !!" & .Cells(ligne,
1)
End If
End If
End With
End If
End Sub
-------------------------------------------------------
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub








Cyr13
Le #5178131
bonjour
ok, je test et te tient au courant merci encore
Cyr13
Le #5178101
bonjour
j ai tester mais aucun changement il trouve bien la 1ere valeur numérique
dans la colonne du jour demander ,le nom d onglet a imprimer mais seulement
pour le premier client ou une valeur est present.
(pas forcement le1er de la liste ,aucun soucis de se coter la) il imprime
mais ne filtre pas la feuille avant ??une idée..
merci encore de prendre de ton temps pour moi.
Daniel.C
Le #5178031
Bonjour.
Je t'ai demandé s'il pouvait y avoir plusieurs valeurs dans la colonne.
Qu'est-ce que tu veux filtrer et quel filtre veux-tu appliquer ?
Daniel
"Cyr13"
bonjour
j ai tester mais aucun changement il trouve bien la 1ere valeur numérique
dans la colonne du jour demander ,le nom d onglet a imprimer mais
seulement pour le premier client ou une valeur est present.
(pas forcement le1er de la liste ,aucun soucis de se coter la) il imprime
mais ne filtre pas la feuille avant ??une idée..
merci encore de prendre de ton temps pour moi.



Cyr13
Le #5177961
bonsoir
voici le tableau:

B C D E.........AG
--------------------------------------------
1/1 2/1 3/1
clients 1 10
clients 2
.....
clients 40 25

chaque colonne de jour peut contenir jusqu a 40 valeur autant que de
clients. dés fois on pense etre explicite,je comprend qu il ne soit pas
facile de comprendre les explications des autres avec ce tableau cela
devrait etre plus clair.
et merci encore
Daniel.C
Le #5177861
Regarde le code ci-dessous. Tu ne m'as pas réppondu ppour cette histoire de
filtre.

Sub Imprimer_Feuille_Livraison()
Dim c As Range, ResAdr As String
rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
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:="<>"
Var = Err.Number
Attente (500)
Var = Err.Number
Sheets(feuille).PrintPreview
[J11:K11].AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet 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
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub

Daniel
"Cyr13"
bonsoir
voici le tableau:

B C D E.........AG
--------------------------------------------
1/1 2/1 3/1
clients 1 10
clients 2
.....
clients 40 25

chaque colonne de jour peut contenir jusqu a 40 valeur autant que de
clients. dés fois on pense etre explicite,je comprend qu il ne soit pas
facile de comprendre les explications des autres avec ce tableau cela
devrait etre plus clair.
et merci encore




Cyr13
Le #5235091
bonsoir Daniel.C
que dire sinon que tu es formidable cela marche impecable.
pour le filtre j ai juste changer le critere <> par 1

ps: puis-je abuser encore de tes connaissances en te demandant si il est
possible qu une macro ajoute les onglets elle meme en prenant le nom des
clients sur la feuille "effectifs clients"de B6:B45 et qu elle colle se nom
en cellule E12 sur chaque onglets qu elle ajoute
Daniel.C
Le #5235081
Bonsoir.
Essaie :

Sub CreerFeuilles()
Dim c As Range
For Each c In ['effectifs clients'!B6:B45]
If c <> "" Then
Sheets.Add.Name = c.Value
[E12] = c.Value
End If
Next c
End Sub

Cordialement.
Daniel
"Cyr13" %

bonsoir Daniel.C
que dire sinon que tu es formidable cela marche impecable.
pour le filtre j ai juste changer le critere <> par 1

ps: puis-je abuser encore de tes connaissances en te demandant si il est
possible qu une macro ajoute les onglets elle meme en prenant le nom des
clients sur la feuille "effectifs clients"de B6:B45 et qu elle colle se
nom en cellule E12 sur chaque onglets qu elle ajoute



Publicité
Poster une réponse
Anonyme