J'ai un fichier avec plusieurs sheet ds chacune des sheet
plusieurs rectangle
Je souhaiterais pouvoir copier en auto la meme picture ds le haut de chacun
des rectangles mais je n'y arrive pas. ça marche avec du texte que j'ai mis
ds la sheet Plan, je met la formule suivante ds le haut de mon recatngle
=PLAN!$K$1
Par contre comment je fais pour copier ma picture picture automatiquement ds
le haut de chacun de mes recatngle?????
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
isabelle
bonjour rs,
voici un début de piste :
Sub MesImage() For Each f In Worksheets Sheets(f.Name).Select For Each sh In ActiveSheet.Shapes g = sh.Name ActiveSheet.Shapes(g).Select x = Selection.Top y = Selection.Left ActiveSheet.Pictures.Insert("C:Mes documentsMes imageszaza.bmp").Select With Selection .ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft .ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft .Top = x .Left = y End With Next Next End Sub
'pour effacer les images :
Sub EffacerPicture() For Each f In Worksheets Sheets(f.Name).Select For Each sh In ActiveSheet.Shapes g = sh.Name If Left(g, 7) Like "Picture" Then ActiveSheet.Shapes(g).Delete Next Next End Sub
isabelle
J'ai un fichier avec plusieurs sheet ds chacune des sheet plusieurs rectangle Je souhaiterais pouvoir copier en auto la meme picture ds le haut de chacun des rectangles mais je n'y arrive pas. ça marche avec du texte que j'ai mis ds la sheet Plan, je met la formule suivante ds le haut de mon recatngle =PLAN!$K$1 Par contre comment je fais pour copier ma picture picture automatiquement ds le haut de chacun de mes recatngle?????
Merci pour votre aide
bonjour rs,
voici un début de piste :
Sub MesImage()
For Each f In Worksheets
Sheets(f.Name).Select
For Each sh In ActiveSheet.Shapes
g = sh.Name
ActiveSheet.Shapes(g).Select
x = Selection.Top
y = Selection.Left
ActiveSheet.Pictures.Insert("C:Mes documentsMes imageszaza.bmp").Select
With Selection
.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
.Top = x
.Left = y
End With
Next
Next
End Sub
'pour effacer les images :
Sub EffacerPicture()
For Each f In Worksheets
Sheets(f.Name).Select
For Each sh In ActiveSheet.Shapes
g = sh.Name
If Left(g, 7) Like "Picture" Then ActiveSheet.Shapes(g).Delete
Next
Next
End Sub
isabelle
J'ai un fichier avec plusieurs sheet ds chacune des sheet
plusieurs rectangle
Je souhaiterais pouvoir copier en auto la meme picture ds le haut de chacun
des rectangles mais je n'y arrive pas. ça marche avec du texte que j'ai mis
ds la sheet Plan, je met la formule suivante ds le haut de mon recatngle
=PLAN!$K$1
Par contre comment je fais pour copier ma picture picture automatiquement ds
le haut de chacun de mes recatngle?????
Sub MesImage() For Each f In Worksheets Sheets(f.Name).Select For Each sh In ActiveSheet.Shapes g = sh.Name ActiveSheet.Shapes(g).Select x = Selection.Top y = Selection.Left ActiveSheet.Pictures.Insert("C:Mes documentsMes imageszaza.bmp").Select With Selection .ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft .ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft .Top = x .Left = y End With Next Next End Sub
'pour effacer les images :
Sub EffacerPicture() For Each f In Worksheets Sheets(f.Name).Select For Each sh In ActiveSheet.Shapes g = sh.Name If Left(g, 7) Like "Picture" Then ActiveSheet.Shapes(g).Delete Next Next End Sub
isabelle
J'ai un fichier avec plusieurs sheet ds chacune des sheet plusieurs rectangle Je souhaiterais pouvoir copier en auto la meme picture ds le haut de chacun des rectangles mais je n'y arrive pas. ça marche avec du texte que j'ai mis ds la sheet Plan, je met la formule suivante ds le haut de mon recatngle =PLAN!$K$1 Par contre comment je fais pour copier ma picture picture automatiquement ds le haut de chacun de mes recatngle?????
