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 [HS] Loisir de vieux retraité

[HS] Loisir de vieux retraité

12 réponses
Avatar
garnote
Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)
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
JLuc
garnote avait soumis l'idée :
Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

--
JLuc

Avatar
garnote
Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de news:

garnote avait soumis l'idée :
Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

--
JLuc





Avatar
isabelle
salut Serge,

ça fonctionne très bien sur xp,
c'est bien pensé, fichier à conserver.

bisou*
isabelle

Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de news:


garnote avait soumis l'idée :

Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

--
JLuc










Avatar
isabelle
j'ai ajouté ce bout de code,

Sub InsereCadre()
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 100, 75, 75).Select
With Selection
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Fill.Transparency = 0#
.Name = "Cadre"
End With

isabelle


salut Serge,

ça fonctionne très bien sur xp,
c'est bien pensé, fichier à conserver.

bisou*
isabelle


Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de
news:

garnote avait soumis l'idée :

Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)



Desole, Excel 2000 ca marche pas :/

--
JLuc












Avatar
garnote
Hé! Hé!, Bonjour Isabelle,

Êtes-vous épargné par les rigueurs de l'hiver
dans vos cantons ?
À Québec, c'est un hiver printanier.
L'hiver des Indiens, peut être ;-)

Bisous aussi

Serge


"isabelle" a écrit dans le message de news:

salut Serge,

ça fonctionne très bien sur xp,
c'est bien pensé, fichier à conserver.

bisou*
isabelle

Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de news:


garnote avait soumis l'idée :

Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

--
JLuc











Avatar
Modeste
Bonsour® isabelle avec ferveur ;o))) vous nous disiez :

ça fonctionne très bien sur xp,


Arghhhh.....
Bouhhhhh !!!!
XP, excel 2002
chez moi, ça ne marche pas !!!

Oupppssss !!!
trouvé !!!
ça ne marchait pas c'était un GiF animé !!!


voir là : http://cjoint.com/?ccucPpkUIp
il y a 4 images
BMP,JPG,GIF et ANIGIF



--
;o)))
@+

Les news à la source !!!
news://news.microsoft.com/microsoft.public.fr.excel
et répondez OUI

n'oubliez pas les FAQ :http://www.excelabo.net
http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr

Avatar
JLuc
*Bonjour garnote*,
J'ai reesaye chez moi, ca marche : vraiment genial
Bravo

Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de news:

garnote avait soumis l'idée :
Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

-- JLuc






--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O



Avatar
isabelle
Hé! Hé!, Bonjour Isabelle,
Êtes-vous épargné par les rigueurs de l'hiver
dans vos cantons ?
À Québec, c'est un hiver printanier.
L'hiver des Indiens, peut être ;-)


même chose par chez nous, on est à la veille de faire pousser les oranges :-)

isabelle

Avatar
Pierre CFI [mvp]
Ce que dirait JPS si il sortait de temps en temps de son lit :"p'tain, vlà qu'il a attendu la retraite pour bosser" :o)

--
Pierre CFI
MVP Microsoft Access

"garnote" a écrit dans le message de news: %
Hé! Hé!, Bonjour Isabelle,

Êtes-vous épargné par les rigueurs de l'hiver
dans vos cantons ?
À Québec, c'est un hiver printanier.
L'hiver des Indiens, peut être ;-)

Bisous aussi

Serge


"isabelle" a écrit dans le message de news:
salut Serge,

ça fonctionne très bien sur xp,
c'est bien pensé, fichier à conserver.

bisou*
isabelle

Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de news:

garnote avait soumis l'idée :

Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

--
JLuc














Avatar
LSteph
Bonsoir à tous,
Chez moi cela ne fonctionne pas non plus err438 :

With Selection.ShapeRange.PictureFormat

Merci d'avance.
lSteph

JLuc" a écrit dans le message de news:

*Bonjour garnote*,
J'ai reesaye chez moi, ca marche : vraiment genial
Bravo

Salut JLuc,

Bizarre, chez moi, avec Excel 2000, ça fonctionne !
La partie extraite apparaît sur une nouvelle feuille.

Serge

"JLuc" a écrit dans le message de news:

garnote avait soumis l'idée :
Bonjour mes vous tous,

Deux tites macros pour le plaisir.
Elles permettent d'extraire une partie
rectangulaire d'une image.
1. Insérez une image sur une feuille de calcul,
2. Insérez un rectangle sans aucun remplissage,
3. Nommez ce rectangle "cadre",
4. Placez le cadre (premier-plan) sur une
partie de l'image,
5. Sélectionnez l'image,
6. Appelez la macro Extraire.

Sub Extraire()
nom = ActiveSheet.Name
With ActiveSheet.Shapes("cadre")
LC = .Left
TC = .Top
WC = .Width
HC = .Height
End With
With Selection
LS = .Left
TS = .Top
WS = .Width
HS = .Height
End With
With Selection.ShapeRange.PictureFormat
.CropLeft = LC - LS
.CropTop = TC - TS
.CropRight = LS + WS - LC - WC
.CropBottom = TS + HS - TC - HC
End With
Selection.Copy
Sheets.Add
ActiveSheet.Paste
[A1].Select
Worksheets(nom).Activate
Rétablir
End Sub

Sub Rétablir()
With Selection.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub

Serge ;-)


Desole, Excel 2000 ca marche pas :/

-- JLuc






--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O







1 2