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

2 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
*Bonjour LSteph*,
Attention de bien selectionner l'image et non le cadre avant d'executer
la macro ;-)

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






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

O-O





Avatar
LSteph
;o) merci JLuc c'était bien cela!

Et merci et bravo à Serge pour cette trouvaille.
....une de plus!

Cordialement.

lSteph

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

*Bonjour LSteph*,
Attention de bien selectionner l'image et non le cadre avant d'executer la
macro ;-)

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






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

O-O









1 2