Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Maudite boucles...

Maudite boucles...

8 réponses
Avatar
Angela
bonjour à tous, et particulierement a Alain (AV) qui m'a bien aidé pour la
traduction de mon script...
Maintenant que le sript est traduit...et qu'il marche, je veux y apporter
une modification.
Voila, la macro en question permet de saisir des bl et de les imprimer (sans
sauvegarder quoi que ce soit).En fin de mois, les utilistateurs saisissent
dans un tableau toutes les lignes de leur bon de livraison dont ils on
garder une copie.
Donc, lors de l'impression je voudrai ajouter une étape qui parcour le BL et
qui recopie les cellules non vides dans une feuille BL2 qui elle n'est pas
mise a blanc.
Voici le script. Je n'arrive pas a trouver la boucle qui me permette de
parcourir mon BL...

Sub Impression()

Dim ligg As Integer
Dim liggn As Integer

ligg = 0
liggn = 0
' COPIE DE BL SPIT VERS BL SPIT 2
Sheets("BL SPIT").Activate
Range("A10").Select
While (ActiveCell <> "")
ActiveCell.Select
Selection.Copy 'copie de la référence
Sheets("BL SPIT2").Activate
Range("A10").Select
' RECHERCHE DE LA LIGNE VIDE DANS BL SPIT2
While (ActiveCell <> "")
ActiveCell.Offset(1, 0).Activate
Wend
ActiveCell.Offset(0, 1).Activate
While (ActiveCell <> "")
ActiveCell.Offset(1, 0).Activate
Wend
ActiveCell.Offset(0, -1).Activate
ActiveCell.Offset(0, 6).Activate
While (ActiveCell <> "")
ActiveCell.Offset(1, 0).Activate
Wend
ActiveCell.Offset(0, -6).Activate
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False 'collage
reference
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 2).Activate
ActiveCell.Select
Selection.Copy 'Copie de la
désignation
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de NBRE CARTON
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de QTE PAR
CARTON
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de qte par
carton
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de code prix
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de nbre de
palette
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Wend

' IMPRESSION DE BL SPIT
DrapeauContinuer = True
DrapeauImpression = True
Do
Sheets("BL SPIT").Activate
Range("B7").Select
If DrapeauImpression Then
BL = Range("G2").Value
BL = BL + 1
Range("G2").Value = BL
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
ActiveCell.Value = BL
Sheets("BL SPIT").Activate
Range("B5").Value = Info(6)
Range("C7").Value = Info(8)
If (Info(15) <> "") Then
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = Info(15) & Chr(10) &
Info(16) & Chr(10) & Info(17) & Chr(10) & Info(18) & Chr(32) & Info(19)
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
Range("B7").Select
DrapeauContinuer = False
Else
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "SPIT" & Chr(10) & "SERVICE
BU CHEVILLES" & Chr(10) & "ROUTE DE LYON" & Chr(10) & "26500 BOURG LES
VALENCE"
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "SKIPPER" & Chr(10) & "ZI
les Gonettes" & Chr(10) & "07800 LA VOULTE"
Presentation1
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "TEPPE" & Chr(10) & "SERVICE
COMPTABILITE" & Chr(10) & "'ATELIER STT'" & Chr(10) & "26600 TAIN
L'HERMITAGE"
Presentation
Presentation1
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "TEPPE" & Chr(10) & "ATELIER
STT" & Chr(10) & "26600 TAIN L'HERMITAGE"
Presentation1
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
' Cache le travail fait par Presentation1
ActiveSheet.DrawingObjects("Texte 13").Select
Selection.Characters.Text = "SPIT (BU CHEVILLE)" &
Chr(10) & "26500 BOURG LES VALENCE"
With Selection.Characters(Start:=1,
Length:=50).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = 2
End With
Range("A1").Select
DrapeauContinuer = False
End If
End If

Loop While DrapeauContinuer
Sheets("Presentation").Activate
DrapeauAffichage = True
boite = "Page Choix"
While DrapeauAffichage = True
DialogSheets(boite).Show
Wend
End Sub
Signaler un problème avec ce contenu

8 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
Avatar
sabatier
bonjour angela
AV t'a bien appâtée mais maintenant, il facture ses extras ; étant son
comptable attitré, je te remercie de me donner ton n° de TVA
intracommunautaire, le nombre d'exemplaires de facture souhaité et la langue
à utiliser, sachant que par défaut, ce document sort en patois corrézien à
la demande expresse de chirac...
jps

Angela wrote:
bonjour à tous, et particulierement a Alain (AV) qui m'a bien aidé
pour la traduction de mon script...
Maintenant que le sript est traduit...et qu'il marche, je veux y
apporter une modification.


Avatar
Angela
Je paierai le prix qu'il faut mais par pitié de l'aide..................
"sabatier" a écrit dans le message news:

bonjour angela
AV t'a bien appâtée mais maintenant, il facture ses extras ; étant son
comptable attitré, je te remercie de me donner ton n° de TVA
intracommunautaire, le nombre d'exemplaires de facture souhaité et la
langue

à utiliser, sachant que par défaut, ce document sort en patois corrézien à
la demande expresse de chirac...
jps

Angela wrote:
bonjour à tous, et particulierement a Alain (AV) qui m'a bien aidé
pour la traduction de mon script...
Maintenant que le sript est traduit...et qu'il marche, je veux y
apporter une modification.






Avatar
Angéla
re bonjour sabatier, en langage claire ca donne quoi... :)??????
Avatar
sabatier
sois patiente, angela, ça va viendre, pas de moi et pourtant, comme je serai
heureux de te venir en aide...
jps
PS alors les cracks, vous la dépannez angela qui implore votre pitié?

"Angela" a écrit dans le message de
news:
Je paierai le prix qu'il faut mais par pitié de l'aide..................
"sabatier" a écrit dans le message news:

bonjour angela
AV t'a bien appâtée mais maintenant, il facture ses extras ; étant son
comptable attitré, je te remercie de me donner ton n° de TVA
intracommunautaire, le nombre d'exemplaires de facture souhaité et la
langue

à utiliser, sachant que par défaut, ce document sort en patois corrézien
à


la demande expresse de chirac...
jps

Angela wrote:
bonjour à tous, et particulierement a Alain (AV) qui m'a bien aidé
pour la traduction de mon script...
Maintenant que le sript est traduit...et qu'il marche, je veux y
apporter une modification.










Avatar
sabatier
oups, comme je seraiS....
jps
"sabatier" a écrit dans le message
de news:
sois patiente, angela, ça va viendre, pas de moi et pourtant, comme je
serai

heureux de te venir en aide...
jps
PS alors les cracks, vous la dépannez angela qui implore votre pitié?

"Angela" a écrit dans le message de
news:
Je paierai le prix qu'il faut mais par pitié de l'aide..................
"sabatier" a écrit dans le message news:

bonjour angela
AV t'a bien appâtée mais maintenant, il facture ses extras ; étant son
comptable attitré, je te remercie de me donner ton n° de TVA
intracommunautaire, le nombre d'exemplaires de facture souhaité et la
langue

à utiliser, sachant que par défaut, ce document sort en patois
corrézien



à
la demande expresse de chirac...
jps

Angela wrote:
bonjour à tous, et particulierement a Alain (AV) qui m'a bien aidé
pour la traduction de mon script...
Maintenant que le sript est traduit...et qu'il marche, je veux y
apporter une modification.














Avatar
Angéla
tu fais bien de rectifier... J'avais pris la phrase au futur et j'attendais
une solution de ta part...:)))
Avatar
sabatier
hé hé angela, tu n'as jamais entendu dire que le cumul des mandats n'était
pas une bonne chose ; moi, je m'accroche à mon siège de MVP HS et ne brigue
rien d'autre ; j'essaie par contre de stimuler ceux qui peuvent t'aider mais
j'ai peur qu'ils n'aient pas eu le courage de lire jusqu'au bout ta proc...
jps

Angéla wrote:
tu fais bien de rectifier... J'avais pris la phrase au futur et
j'attendais une solution de ta part...:)))


Avatar
FxM
Bonjour Angela,

Il est particulièrement difficile de reprendre un projet lorsqu'on y a
pas mis les mains.
Le problème principal est de retrouver comment cela a été pensé surtout
lorsque l'on ne dispose pas d'un modèle de données.
En prmière approche ...

Je dois dire que la première partie avec les While (ActiveCell <> "") ->
Wend me laisse dubitatif.
AMHA, il y a des simplifications qui pourraient être aisément faites et
cela permettrait de "déblayer" le terrain pour les modifs que tu envisages.

ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
peuvent la plupart du temps se contracter en :

ActiveCell.Offset(0, 1).Select


et il n'est généralement pas nécessaire de sélectionner pour copier :
ActiveCell.Offset(0, 1).Select
Selection.Copy
peuvent devenir :

ActiveCell.Offset(0, 1).Copy


Après avoir choisi ton endroit qui va recevoir les données :
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue, Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse

tu aurais le loisir de choisir un autre endroit pour y effectuer la même
opération ...

@+
FxM








Angela wrote:

bonjour à tous, et particulierement a Alain (AV) qui m'a bien aidé pour la
traduction de mon script...
Maintenant que le sript est traduit...et qu'il marche, je veux y apporter
une modification.
Voila, la macro en question permet de saisir des bl et de les imprimer (sans
sauvegarder quoi que ce soit).En fin de mois, les utilistateurs saisissent
dans un tableau toutes les lignes de leur bon de livraison dont ils on
garder une copie.
Donc, lors de l'impression je voudrai ajouter une étape qui parcour le BL et
qui recopie les cellules non vides dans une feuille BL2 qui elle n'est pas
mise a blanc.
Voici le script. Je n'arrive pas a trouver la boucle qui me permette de
parcourir mon BL...

Sub Impression()

Dim ligg As Integer
Dim liggn As Integer

ligg = 0
liggn = 0
' COPIE DE BL SPIT VERS BL SPIT 2
Sheets("BL SPIT").Activate
Range("A10").Select
While (ActiveCell <> "")
ActiveCell.Select
Selection.Copy 'copie de la référence
Sheets("BL SPIT2").Activate
Range("A10").Select
' RECHERCHE DE LA LIGNE VIDE DANS BL SPIT2
While (ActiveCell <> "")
ActiveCell.Offset(1, 0).Activate
Wend
ActiveCell.Offset(0, 1).Activate
While (ActiveCell <> "")
ActiveCell.Offset(1, 0).Activate
Wend
ActiveCell.Offset(0, -1).Activate
ActiveCell.Offset(0, 6).Activate
While (ActiveCell <> "")
ActiveCell.Offset(1, 0).Activate
Wend
ActiveCell.Offset(0, -6).Activate
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse 'collage
reference
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 2).Activate
ActiveCell.Select
Selection.Copy 'Copie de la
désignation
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de NBRE CARTON
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de QTE PAR
CARTON
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de qte par
carton
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de code prix
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse
Sheets("BL SPIT").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
Selection.Copy 'Copie de nbre de
palette
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone _
, SkipBlanks:úlse, Transpose:úlse
Wend

' IMPRESSION DE BL SPIT
DrapeauContinuer = True
DrapeauImpression = True
Do
Sheets("BL SPIT").Activate
Range("B7").Select
If DrapeauImpression Then
BL = Range("G2").Value
BL = BL + 1
Range("G2").Value = BL
Sheets("BL SPIT2").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Select
ActiveCell.Value = BL
Sheets("BL SPIT").Activate
Range("B5").Value = Info(6)
Range("C7").Value = Info(8)
If (Info(15) <> "") Then
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = Info(15) & Chr(10) &
Info(16) & Chr(10) & Info(17) & Chr(10) & Info(18) & Chr(32) & Info(19)
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
Range("B7").Select
DrapeauContinuer = False
Else
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "SPIT" & Chr(10) & "SERVICE
BU CHEVILLES" & Chr(10) & "ROUTE DE LYON" & Chr(10) & "26500 BOURG LES
VALENCE"
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "SKIPPER" & Chr(10) & "ZI
les Gonettes" & Chr(10) & "07800 LA VOULTE"
Presentation1
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "TEPPE" & Chr(10) & "SERVICE
COMPTABILITE" & Chr(10) & "'ATELIER STT'" & Chr(10) & "26600 TAIN
L'HERMITAGE"
Presentation
Presentation1
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.DrawingObjects("Texte 5").Select
Selection.Characters.Text = "TEPPE" & Chr(10) & "ATELIER
STT" & Chr(10) & "26600 TAIN L'HERMITAGE"
Presentation1
Presentation
Worksheets("BL SPIT").PrintOut From:=1, To:=1, Copies:=1
' Cache le travail fait par Presentation1
ActiveSheet.DrawingObjects("Texte 13").Select
Selection.Characters.Text = "SPIT (BU CHEVILLE)" &
Chr(10) & "26500 BOURG LES VALENCE"
With Selection.Characters(Start:=1,
Length:P).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = 2
End With
Range("A1").Select
DrapeauContinuer = False
End If
End If

Loop While DrapeauContinuer
Sheets("Presentation").Activate
DrapeauAffichage = True
boite = "Page Choix"
While DrapeauAffichage = True
DialogSheets(boite).Show
Wend
End Sub