Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel [vba] saut de page selon taille d'une image?

[vba] saut de page selon taille d'une image?

6 réponses
Avatar
Oliv'
Bonjour à tous,
J'ai une feuille sur laquelle il n'y a que des images
Je voudrais INSERER un saut de page avant l'image si celle-ci est sur 2
pages.
-->13 en l'occurence (shapes)

Toutes mes lignes ont une hauteur de 12.75 points
et pagesetup.topmargin =42 points

quand je laisse les sauts de page automatiques il se trouvent en lignes
93,185,277,369,461,553.

image 1 top = 0 height = 782.25
image 2 top = 820.5 height =624.75
image 3 top = 1483.5 height =411.75 etc...

Bien sur la taille des images peux varier mais chaque image est séparée par
38.25 points

je dois donc comparer (Image.Top + Image.Height) à
HPageBreak(1).Location.Cells.Row*12.75

Quelqu'un aurait 'il cela en magasin ;-))) ???


--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Signaler un problème avec ce contenu

6 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
Oliv'
Voici le résultat de mon travail
Si vous l'utilisez ca serait sympa de me prévenir
les remarques sont également les bienvenues
si ca vous interesse je vous dirais les raisons de cette macro ;-)))

Sub sautpage()
'
' Macro enregistrée le 21/10/2005 par Olivier CATTEAU
'

Application.ScreenUpdating = False
Dim msg As String
Set mafeuille = Application.Sheets("Impression")
mafeuille.ResetAllPageBreaks

Set Image = mafeuille.Shapes
Set Break = mafeuille.HPageBreaks

For i = 1 To Image.Count
Image.Item(i).Select
t = Image.Item(i).Top
b = Image.Item(i).Top + Image(i).Height

For s = 1 To Break.Count
Sh = (Break.Item(s).Location.Cells.Row - 1) * 12.75
If t < Sh And b > Sh Then

msg = msg & vbCr & "Image : " & i & " Top image : " & t & " bottom image: "
& b & " _
saut : " & s & " position :" & (Break(s).Location.Cells.Row - 1) * 12.75
newsh = "a" & Int(t / 12.75)
If newsh = "a0" Then newsh = "a1"

Set mafeuille.HPageBreaks.Item(s).Location = Range(newsh)
End If
Next s
Next i
MsgBox "Terminé : " & vbCr & msg
End Sub

Oliv' <(supprimerceci) que je salut a écrit
dans Ohv7%
Bonjour à tous,
J'ai une feuille sur laquelle il n'y a que des images
Je voudrais INSERER un saut de page avant l'image si celle-ci est sur
2 pages.
-->13 en l'occurence (shapes)

Toutes mes lignes ont une hauteur de 12.75 points
et pagesetup.topmargin B points

quand je laisse les sauts de page automatiques il se trouvent en
lignes 93,185,277,369,461,553.

image 1 top = 0 height = 782.25
image 2 top = 820.5 height b4.75
image 3 top = 1483.5 height A1.75 etc...

Bien sur la taille des images peux varier mais chaque image est
séparée par 38.25 points

je dois donc comparer (Image.Top + Image.Height) à
HPageBreak(1).Location.Cells.Row*12.75

Quelqu'un aurait 'il cela en magasin ;-))) ???


Avatar
michdenis
Bonjour Oliv,

Je te propose cette façon de faire :

'--------------------------------------
Sub IntercepterChevauchement_Image_PageBreaks()

Dim Rg As Range, Sh As Shape, F As Worksheet

Set F = Worksheets("Feuil1")
For Each Sh In F.Shapes
If TypeName(Sh.OLEFormat.Object) = "Picture" Then
Set Rg = Range(Sh.BottomRightCell, Sh.TopLeftCell)
A = NumeroPage(Rg(1, 1))
B = NumeroPage(Rg(Rg.Rows.Count, Rg.Columns.Count))
If A <> B Then
MsgBox "L'image """ & Sh.Name & """ chevauchera " & _
"à l'impression, " & vbCrLf & " les pages " & _
A & " et " & B & " de la feuille """ & F.Name & _
""".", vbInformation + vbOKOnly, "Attention"
End If
End If
Next

End Sub

'--------------------------------------
Function NumeroPage(Cellule As Range) As Integer
'Crée par : L Longre, mpfe

Dim VPC As Integer, HPC As Integer
Dim VPB As VPageBreak, HPB As HPageBreak
Dim Wksht As Worksheet
Dim Col As Integer, Ligne As Long

Set Wksht = Cellule.Worksheet
Ligne = Cellule.Row
Col = Cellule.Column
If Wksht.PageSetup.Order = xlDownThenOver Then
HPC = Wksht.HPageBreaks.Count + 1
VPC = 1
Else
VPC = Wksht.VPageBreaks.Count + 1
HPC = 1
End If
NumeroPage = 1
For Each VPB In Wksht.VPageBreaks
If VPB.Location.Column > Col Then Exit For
NumeroPage = NumeroPage + HPC
Next VPB
For Each HPB In Wksht.HPageBreaks
If HPB.Location.Row > Ligne Then Exit For
NumeroPage = NumeroPage + VPC
Next HPB

End Function
'--------------------------------------


Salutations!



"Oliv'" <(supprimerceci) a écrit dans le message de news: Ohv7%
Bonjour à tous,
J'ai une feuille sur laquelle il n'y a que des images
Je voudrais INSERER un saut de page avant l'image si celle-ci est sur 2
pages.
-->13 en l'occurence (shapes)

Toutes mes lignes ont une hauteur de 12.75 points
et pagesetup.topmargin B points

quand je laisse les sauts de page automatiques il se trouvent en lignes
93,185,277,369,461,553.

image 1 top = 0 height = 782.25
image 2 top = 820.5 height b4.75
image 3 top = 1483.5 height A1.75 etc...

Bien sur la taille des images peux varier mais chaque image est séparée par
38.25 points

je dois donc comparer (Image.Top + Image.Height) à
HPageBreak(1).Location.Cells.Row*12.75

Quelqu'un aurait 'il cela en magasin ;-))) ???


--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Avatar
michdenis
Légère correction de la première section de la procédure :
'----------------------------

Sub IntercepterChevauchement_Image_PageBreaks()

Dim Rg As Range, Sh As Shape, F As Worksheet
Dim A As Integer, B As Integer
Set F = Worksheets("Feuil1")
For Each Sh In F.Shapes
If TypeName(Sh.OLEFormat.Object) = "Picture" Then
Set Rg = Range(Sh.BottomRightCell, Sh.TopLeftCell)
A = NumeroPage(Rg(1, 1))
B = NumeroPage(Rg(Rg.Rows.Count, Rg.Columns.Count))
If A + B > 0 And A <> B Then
MsgBox "L'image """ & Sh.Name & """ chevauchera " & _
"à l'impression, " & vbCrLf & " les pages " & _
A & " et " & B & " de la feuille """ & F.Name & _
""".", vbInformation + vbOKOnly, "Attention"
End If
End If
Next

End Sub
'----------------------------

Function NumeroPage(Cellule As Range) As Integer
'Crée par : L Longre, mpfe

Dim VPC As Integer, HPC As Integer
Dim VPB As VPageBreak, HPB As HPageBreak
Dim Wksht As Worksheet
Dim Col As Integer, Ligne As Long

Set Wksht = Cellule.Worksheet
Ligne = Cellule.Row
Col = Cellule.Column
If Wksht.PageSetup.Order = xlDownThenOver Then
HPC = Wksht.HPageBreaks.Count + 1
VPC = 1
Else
VPC = Wksht.VPageBreaks.Count + 1
HPC = 1
End If
NumeroPage = 1
For Each VPB In Wksht.VPageBreaks
If VPB.Location.Column > Col Then Exit For
NumeroPage = NumeroPage + HPC
Next VPB
For Each HPB In Wksht.HPageBreaks
If HPB.Location.Row > Ligne Then Exit For
NumeroPage = NumeroPage + VPC
Next HPB

End Function
'--------------------------------------


Salutations!



"Oliv'" <(supprimerceci) a écrit dans le message de news: Ohv7%
Bonjour à tous,
J'ai une feuille sur laquelle il n'y a que des images
Je voudrais INSERER un saut de page avant l'image si celle-ci est sur 2
pages.
-->13 en l'occurence (shapes)

Toutes mes lignes ont une hauteur de 12.75 points
et pagesetup.topmargin B points

quand je laisse les sauts de page automatiques il se trouvent en lignes
93,185,277,369,461,553.

image 1 top = 0 height = 782.25
image 2 top = 820.5 height b4.75
image 3 top = 1483.5 height A1.75 etc...

Bien sur la taille des images peux varier mais chaque image est séparée par
38.25 points

je dois donc comparer (Image.Top + Image.Height) à
HPageBreak(1).Location.Cells.Row*12.75

Quelqu'un aurait 'il cela en magasin ;-))) ???


--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Avatar
Oliv'
michdenis que je salut a écrit
Merci beaucoup, c'est très intéressant et ca fonctionne très bien pour
afficher les "conflits",
cependant je dois également bouger automatiquement les sauts de pages H !
ma macro fonctionnant assez bien pour faire cela je vais juste un peu
l'améliorer.

je n'avais pas vu les propriétés BottomRightCell et TopLeftCell



Ce que je ne comprends pas par contre c'est que dans une boucle
For i =1 to Sh.count
Sh(i).select
Next i
J'ai l'impression que le i=1 ne désigne pas toujours la même image à chaque
fois que je lance la macro?!
mais bon suis peut être parano ;-))))

Quelle différence ya t'il entre un test sur TypeName(Sh.OLEFormat.Object) et
sur sh.type ?
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Légère correction de la première section de la procédure :
'----------------------------

Sub IntercepterChevauchement_Image_PageBreaks()

Dim Rg As Range, Sh As Shape, F As Worksheet
Dim A As Integer, B As Integer
Set F = Worksheets("Feuil1")
For Each Sh In F.Shapes
If TypeName(Sh.OLEFormat.Object) = "Picture" Then
Set Rg = Range(Sh.BottomRightCell, Sh.TopLeftCell)
A = NumeroPage(Rg(1, 1))
B = NumeroPage(Rg(Rg.Rows.Count, Rg.Columns.Count))
If A + B > 0 And A <> B Then
MsgBox "L'image """ & Sh.Name & """ chevauchera " & _
"à l'impression, " & vbCrLf & " les pages " & _
A & " et " & B & " de la feuille """ & F.Name & _
""".", vbInformation + vbOKOnly, "Attention"
End If
End If
Next

End Sub
'----------------------------

Function NumeroPage(Cellule As Range) As Integer
'Crée par : L Longre, mpfe

Dim VPC As Integer, HPC As Integer
Dim VPB As VPageBreak, HPB As HPageBreak
Dim Wksht As Worksheet
Dim Col As Integer, Ligne As Long

Set Wksht = Cellule.Worksheet
Ligne = Cellule.Row
Col = Cellule.Column
If Wksht.PageSetup.Order = xlDownThenOver Then
HPC = Wksht.HPageBreaks.Count + 1
VPC = 1
Else
VPC = Wksht.VPageBreaks.Count + 1
HPC = 1
End If
NumeroPage = 1
For Each VPB In Wksht.VPageBreaks
If VPB.Location.Column > Col Then Exit For
NumeroPage = NumeroPage + HPC
Next VPB
For Each HPB In Wksht.HPageBreaks
If HPB.Location.Row > Ligne Then Exit For
NumeroPage = NumeroPage + VPC
Next HPB

End Function
'--------------------------------------


Salutations!



"Oliv'" <(supprimerceci) a écrit dans le
message de news: Ohv7% Bonjour à
tous,
J'ai une feuille sur laquelle il n'y a que des images
Je voudrais INSERER un saut de page avant l'image si celle-ci est sur
2
pages.
-->13 en l'occurence (shapes)

Toutes mes lignes ont une hauteur de 12.75 points
et pagesetup.topmargin B points

quand je laisse les sauts de page automatiques il se trouvent en
lignes 93,185,277,369,461,553.

image 1 top = 0 height = 782.25
image 2 top = 820.5 height b4.75
image 3 top = 1483.5 height A1.75 etc...

Bien sur la taille des images peux varier mais chaque image est
séparée par
38.25 points

je dois donc comparer (Image.Top + Image.Height) à
HPageBreak(1).Location.Cells.Row*12.75

Quelqu'un aurait 'il cela en magasin ;-))) ???


Avatar
michdenis
Bonjour Oliv,

| ma macro fonctionnant assez bien pour faire cela

***Si tu es satisfait de ta macro, tant mieux !

| Ce que je ne comprends pas par contre c'est que dans une boucle

*** L'ordre avec lequel excel effectue sa boucle est déterminé par l'ordre avec lequel tu as créé les contrôles affichés.

| Quelle différence ya t'il entre un test sur TypeName(Sh.OLEFormat.Object) et sur sh.type ?

***TypeName(Sh.OLEFormat.Object) s'utilise pour déterminer à quel type (sous-famille de la collection shape) de contrôle issu de la
barre d'outils "FORMULAIRE" il appartient.


***Pour ce qui est de shapes(i).type
pour te donner une idée de l'information retournée par cette ligne de commande, ouvre l'explorateur d'objets dans la fenêtre vbe et
entre dans la boîte de saisie recherche : MsoShapeType . Tu vas obtenir la liste des constantes possibles dans la section de droite
du bas de la fenêtre. Si tu sélectionnes un élément de cette liste, tu retrouveras dans le bas de la fenêtre, la constante sous sa
forme numérique.

Tous les objets que tu peux inclure dans une feuille de calcul appartiennent à la grande famille (collection) "Shapes". "
shapes(i).type " te permet d'identifier à quelle grande sous-catégorie appartient un contrôle mais il ne te définit pas si le
contrôle appartenant à une sous-catégorie est une contrôle "Image" ou Bouton de commande ...

Fais le test suivant sur des contrôles issus de la boîte à outils contrôle dans une feuille.
la différence devrait être évidente.
'----------------------
Sub Exemple()

Dim S As MsoShapeType

S = msoOLEControlObject
'msoOLEControlObject = _
'tous les contrôles issus de la barre
'd'outils "Contrôle" sans distinction.

For i = 1 To Me.Shapes.Count
If Me.Shapes(i).Type = S Then
MsgBox Me.Shapes(i).Type
MsgBox Me.Shapes(i).OLEFormat.Object.Name
End If
Next i

'----------------------


Salutations!




"Oliv'" <(supprimerceci) a écrit dans le message de news:

michdenis que je salut a écrit
Merci beaucoup, c'est très intéressant et ca fonctionne très bien pour
afficher les "conflits",
cependant je dois également bouger automatiquement les sauts de pages H !
ma macro fonctionnant assez bien pour faire cela je vais juste un peu
l'améliorer.

je n'avais pas vu les propriétés BottomRightCell et TopLeftCell


Ce que je ne comprends pas par contre c'est que dans une boucle
For i =1 to Sh.count
Sh(i).select
Next i
J'ai l'impression que le i=1 ne désigne pas toujours la même image à chaque
fois que je lance la macro?!
mais bon suis peut être parano ;-))))

Quelle différence ya t'il entre un test sur TypeName(Sh.OLEFormat.Object) et
sur sh.type ?
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Légère correction de la première section de la procédure :
'----------------------------

Sub IntercepterChevauchement_Image_PageBreaks()

Dim Rg As Range, Sh As Shape, F As Worksheet
Dim A As Integer, B As Integer
Set F = Worksheets("Feuil1")
For Each Sh In F.Shapes
If TypeName(Sh.OLEFormat.Object) = "Picture" Then
Set Rg = Range(Sh.BottomRightCell, Sh.TopLeftCell)
A = NumeroPage(Rg(1, 1))
B = NumeroPage(Rg(Rg.Rows.Count, Rg.Columns.Count))
If A + B > 0 And A <> B Then
MsgBox "L'image """ & Sh.Name & """ chevauchera " & _
"à l'impression, " & vbCrLf & " les pages " & _
A & " et " & B & " de la feuille """ & F.Name & _
""".", vbInformation + vbOKOnly, "Attention"
End If
End If
Next

End Sub
'----------------------------

Function NumeroPage(Cellule As Range) As Integer
'Crée par : L Longre, mpfe

Dim VPC As Integer, HPC As Integer
Dim VPB As VPageBreak, HPB As HPageBreak
Dim Wksht As Worksheet
Dim Col As Integer, Ligne As Long

Set Wksht = Cellule.Worksheet
Ligne = Cellule.Row
Col = Cellule.Column
If Wksht.PageSetup.Order = xlDownThenOver Then
HPC = Wksht.HPageBreaks.Count + 1
VPC = 1
Else
VPC = Wksht.VPageBreaks.Count + 1
HPC = 1
End If
NumeroPage = 1
For Each VPB In Wksht.VPageBreaks
If VPB.Location.Column > Col Then Exit For
NumeroPage = NumeroPage + HPC
Next VPB
For Each HPB In Wksht.HPageBreaks
If HPB.Location.Row > Ligne Then Exit For
NumeroPage = NumeroPage + VPC
Next HPB

End Function
'--------------------------------------


Salutations!



"Oliv'" <(supprimerceci) a écrit dans le
message de news: Ohv7% Bonjour à
tous,
J'ai une feuille sur laquelle il n'y a que des images
Je voudrais INSERER un saut de page avant l'image si celle-ci est sur
2
pages.
-->13 en l'occurence (shapes)

Toutes mes lignes ont une hauteur de 12.75 points
et pagesetup.topmargin B points

quand je laisse les sauts de page automatiques il se trouvent en
lignes 93,185,277,369,461,553.

image 1 top = 0 height = 782.25
image 2 top = 820.5 height b4.75
image 3 top = 1483.5 height A1.75 etc...

Bien sur la taille des images peux varier mais chaque image est
séparée par
38.25 points

je dois donc comparer (Image.Top + Image.Height) à
HPageBreak(1).Location.Cells.Row*12.75

Quelqu'un aurait 'il cela en magasin ;-))) ???


Avatar
Oliv'
michdenis que je salut a écrit

Bonjour Oliv,

ma macro fonctionnant assez bien pour faire cela


***Si tu es satisfait de ta macro, tant mieux !


c'est sans doute pas des plus académique mais ca rempli son rôle
et je n'ai pas détecté d'erreur lors de l'exécution.

Ce que je ne comprends pas par contre c'est que dans une boucle


*** L'ordre avec lequel excel effectue sa boucle est déterminé par
l'ordre avec lequel tu as créé les contrôles affichés.


C'est ce que je pensais aussi mais j'ai encore un doute

Quelle différence ya t'il entre un test sur
TypeName(Sh.OLEFormat.Object) et sur sh.type ?
ok c'est plus détaillé en quelque sorte.



En fait j'utilise cette macro sur une feuille qui fait la synthèse de
plusieurs autres feuilles sous forme d'images collées avec liaisons pour
générer des rapports en éliminant ce qui n'est pas rempli.

merci beaucoup pour tes excellentes explications.


--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~