boucle avec modulo

Version imprimable

boucle avec modulo

Bonjour,

je suis en train d'essayer de comprendre comment écrire une macro qui fait de la mise en page, j'écris une petite macro de test :
Code:

1 2 3 4 5 6 7 8 Sub test() Range("B5") = Workbooks("classeur2.xlsx").Sheets("Feuil1").Range("A2").Value Range("M6") = Workbooks("classeur2.xlsx").Sheets("Feuil1").Range("B2").Value Range("Q7") = Workbooks("classeur2.xlsx").Sheets("Feuil1").Range("E2").Value End Sub
Cela marche bien pour la première ligne du classeur 2, je vais intégrer cela dans une boucle pour traiter 10 lignes :
Code:

1 2 3 4 5 Dim i as Integer For i = 1 to 10 ... Next i
Je veux faire à chaque incrémentation de i --> modulo 5 sur B5, M6, Q7 --> B10, M11, Q12 et modulo 1 sur A2, B2, E2 --> A3, B3, E3

J'imagine devoir déclarer mes cellules comme variable ? et ensuite ?

08/05/2018, 17h29
Jean-Philippe André

Salut,

je pense qu'on a une erreur de signification dans ton énoncé

Citation:

modulo 1

un modulo c'est un reste de division entière...

de plus, un coup tu tapes sur les colonnes B, M et Q puis a nouveau sur A,B,C

Citation:

B5, M6, Q7 --> B10, M11, Q12 et modulo 1 sur A2, B2, E2 --> A3, B3, E3

Tu pourrais nous donner la liste des 3 premiers cas selon ton approche stp ?

Ca reste nécessaire pour qu'on comprenne vraiment où tu veux en venir :koi:

Merci
08/05/2018, 17h53
retraite83

oui bien sur,

Dans mon test pour voir comment ça marche, je veux traiter 10 lignes de ma feuille "Feuil1" qui contiennent des infos à mettre en page dans ma "Feuil2" (feuille courante)

Ces infos sont pour la 1ere ligne de "Feuil1" en A2, B2 et E2, sur la seconde ligne elles seront donc en A3, B3 et E3 et ainsi de suite. (c'est ce que j'ai appelé modulo 1)

Je veux les mettre dans ma "Feuil2" respectivement pour la ligne 1 de "Feuil1" (A2, B2 et E2) en B5, M6 et Q7

Pour la ligne suivante de "Feuil1" (A3, B3 et E3 ) en B10, M11 et Q12 et ainsi de suite. (c'est ce que j'ai appelé modulo 5)

J'espère avoir été plus clair

Ok,

on aurait un code de ce style :

Code:

1
2
3
4
5
6
7
8
Dim Delta As Integer
Delta=5
For I=2 To 11
Range("B" & Delta) = Workbooks("classeur2.xlsx").Sheets("Feuil1").Range("A" & I).Value
Range("M" & Delta+1) = Workbooks("classeur2.xlsx").Sheets("Feuil1").Range("B" & I).Value
Range("Q" & Delta +2) = Workbooks("classeur2.xlsx").Sheets("Feuil1").Range("E" & I).Value
Delta=Delta+5
Next I

On peut même envisager de virer Delta et de faire tous les calculs à partir de I.

08/05/2018, 18h47
retraite83
C'est parfait et formateur, merci

dans le même esprit je voudrai au passage dans ma boucle copier aussi l'image qui se trouve sur chaque ligne de "Feuil1" classeur2.xlsx en ("A" & I) vers "B" & Delta

Là cela se complique pour moi,

j'ai fait un test (en galérant) pour supprimer l'image dans une boucle en intégrant :
Code:

1 2 3 For Each shap In ActiveSheet.Shapes If shap.TopLeftCell.Row = i Then shap.Delete
mais pour la copier ?
08/05/2018, 18h51
Jean-Philippe André

Essaie de générer du code à partir de l'enregistreur de macro, et tu trouveras ces subtilités de copie/collage d'images :)
08/05/2018, 18h54
retraite83

merci du conseil, je n'ai jamais fait, je vais le faire

Je ne connaissais pas cette possibilité d'enregistreur d'événements, merci de me l'avoir indiquer.

J'obtiens en modifiant un peu :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 For i = 2 To 11 Range("B" & Delta) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Value Range("M" & Delta + 1) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("B" & i).Value Range("Q" & Delta + 2) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("E" & i).Value Windows("ES-Catalogue.xlsm").Activate Sheets("Param Services").Select ActiveSheet.Shapes.Range(Array("Picture 170")).Select Selection.Copy Windows("ES-Edition du Catalogue des Services.xlsm").Activate ActiveWindow.SmallScroll Down:=2 Range("B" & Delta).Select ActiveSheet.Paste Delta = Delta + 5 Next i
questions :

1) a quoi sert :
Code:

1 2 ActiveWindow.SmallScroll Down:=2
est-ce une commande lié à l'utilisation de l'enregistreur ?

2) je copie toujours la même image : Picture 170
la deuxieme s'appelle Picture 2 et ainsi de suite sans règle...
Comment généraliser ? en utilisant la position de la photo et "Delta" au lieu du nom ?

3) Mes photos origines sont trop grandes, je voudrai profiter pour les réduire pour la mise en page au moment de :
Code:

1 2 ActiveSheet.Shapes.Range(Array("Picture 170")).Select ???

08/05/2018, 19h39
Jean-Philippe André
Oui, la ligne

Code:

ActiveWindow.SmallScroll Down:=2

n'a aucune utilité (tu peux donc la supprimer)

Concernant la modification de la taille de l'image, l'enregistreur te permet de le faire également en principe :)

Pour les images, c'est un peu compliqué, mais tu peux effectivement faire une boucle du style
Code:

1 2 3 4 5 6 For Each shp In ActiveSheet.Shapes If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Top Then 'ta manip ici End Next

En cherchant dans les docs Internet je suis arrivé à une mise en page parfaite pour ma première photo (peut être pas puriste mais cela fonctionne)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
Sub Macro1()
Dim Delta As Integer
Dim i As Integer
Dim s As Variant
 
Delta = 6
 
For i = 2 To 2
Range("B" & Delta) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Value
Range("M" & Delta + 1) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("B" & i).Value
Range("Q" & Delta + 2) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("E" & i).Value
 
Windows("ES-Catalogue.xlsm").Activate
    Sheets("Param Services").Select
    ActiveSheet.Shapes.Range(Array("Picture 170")).Select
    Selection.Copy
    Windows("ES-Edition du Catalogue des Services.xlsm").Activate
    Range("B" & Delta + 2).Select
'
' Suppression de l'image résiduelle
'
    For Each s In ActiveSheet.Shapes
     If Not Intersect(s.TopLeftCell, ActiveCell) Is Nothing Then s.Delete
    Next s
'
' Copie de la nouvelle image à la bonne taille
'
ActiveSheet.Paste
Selection.ShapeRange.ScaleHeight 0.4693333333, msoFalse, msoScaleFromTopLeft
 
Delta = Delta + 5
Next i
 
End Sub

Mon problème maintenant c'est d'intégrer cela dans une boucle en suivant tes conseils :

Code:

1
2
3
4
5
6
 
For Each shp In ActiveSheet.Shapes
If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Top Then
ta manip ici
End
Next

Malgré tous mes essais je coince avec des erreurs du type For i sans Next, je ne trouve pas de docs expliquant ce genre de manip

Il manque le If après mon end :oops:

Code:

1
2
3
4
5
For Each shp In ActiveSheet.Shapes
If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Top Then
'ta manip ici
End If
Next

Oui , j'avais vu :P (pour une fois...)

ma macro commence à ressembler à quelque chose (enfin je pense), mais je vois un pb :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Sub Macro1()
Dim Delta As Integer
Dim i As Integer
Dim s As Variant
Application.ScreenUpdating = False
Delta = 6
 
' Boucle sur toutes les lignes du Catalogue
For i = 2 To 3
 
Range("B" & Delta) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Value
Range("M" & Delta + 1) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("B" & i).Value
Range("Q" & Delta + 2) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("E" & i).Value
 
' Catalogue actif
Workbooks("ES-Catalogue.xlsm").Activate
Sheets("Param Services").Select
' ex ligne : ActiveSheet.Shapes.Range(Array("Picture 170")).Select
    For Each shp In ActiveSheet.Shapes
        If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("D" & i).Top Then
            Selection.Copy
 
' Edition du catalogue actif
            Workbooks("ES-Edition du Catalogue des Services.xlsm").Activate
            Range("B" & Delta + 2).Select
'
' Suppression de l'image résiduelle
                For Each s In ActiveSheet.Shapes
                If Not Intersect(s.TopLeftCell, ActiveCell) Is Nothing Then s.Delete
                Next s
'
' Copie de la nouvelle image à la bonne taille
            ActiveSheet.Paste
            Selection.ShapeRange.ScaleHeight 0.4693333333, msoFalse, msoScaleFromTopLeft
 
        End If
    Next
 
Delta = Delta + 5
Next i
 
Application.ScreenUpdating = True
End Sub

en Fait dans :

Code:

1
2
3
 For Each shp In ActiveSheet.Shapes
        If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("D" & i).Top Then
            Selection.Copy

je ne voudrai pas de boucle "For each" puisque elle est dans le même indice i
je voudrai juste faire une fois l'opération et sortir pour le prochain indice i

Et là VBA est beaucoup plus fort que moi pour la syntaxe !

Suis-je clair ?