Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel creation d'une macro par Daniel.C

creation d'une macro par Daniel.C

13 réponses
Avatar
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Daniel.C
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" a écrit dans le message de news:

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




Avatar
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" a écrit dans le message de news:

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




Avatar
Xavier powaga
Daniel au dodo
en tout cas moi j'y vais

"Daniel.C" a écrit dans le message de news:

Si j'ai mal compris et que pour la date entrée, il peut y avoir plusieurs
feuilles, fais-le moi savoir.
Daniel
"Cyr13" a écrit dans le message de news:

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








Avatar
Cyr13
bonjour
ok, je test et te tient au courant merci encore
Avatar
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.
Avatar
Daniel.C
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" a écrit dans le message de news:

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.



Avatar
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
Avatar
Daniel.C
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" a écrit dans le message de news:

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




Avatar
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
Avatar
Daniel.C
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" a écrit dans le message de news:
%

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



1 2