Modification d'image

[Temjeh]

Bonjour et merci d'avance

J'ai collé une image dans ma feuille venat de google map.

Est-ce possible d'avoir un code pour:

grayscale et accentuation de l'image à 90%


Je la rapetisse:

Selection.ShapeRange.ScaleHeight 0.7667624053, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.9796027912, msoFalse, msoScaleFromTopLeft

mais ensuite ...
Merci

 

[Temjeh]

Re : Modification d'image

J'ai trouvé ceci pour tout image en grayscale

Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then
sh.PictureFormat.ColorType = msoPictureGrayscale
End If
Next

Il me manque juste l'option accentuation de l'image à 90%

Merci

 

[phlaurent55]

Re : Modification d'image

Bonjour Temjeh,

peut-être avec ceci:

Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.Type = msoPicture Then
sh.PictureFormat.ColorType = msoPictureGrayscale
sh.PictureFormat.Brightness = 0.3        ' à adapter
sh.PictureFormat.Contrast = 0.7          ' à adapter
End If
    Next

à+
Philippe

 

[Temjeh]

Re : Modification d'image

Bonjour et merci pour ton aide

Ok pour le code contrast.

il y a-t-il un code pour l'option du haut qui est Atténuer & Accentuer (90%)

Merci

 

[Temjeh]

Re : Modification d'image

Pas de réponse, donc impossible?

Merci

 

[MJ13]

Re : Modification d'image

Bonjour à tous

Dire que c'est impossible, ce n'est pas évident.

Si l'enregistreur de macros ne donne rien, comme parfois, même sur XL2010, il faut aller sur l'aide ou sur le net pour essayer de trouver le bon code.

 

[mromain]

Re : Modification d'image

Bonjour Temjeh, Philippe, Michel, le forum,

Sur 2013, cela semble se trouver ici :

sh.Fill.PictureEffects(1).EffectParameters("SharpenSoften").Value = 90

PS : La fenêtre espions est parfaite pour ce type de recherches 🙂

A+

 

[Temjeh]

Re : Modification d'image

Merci

Non l'enregistreur ne fonctionne pas.

Pour sh.Fill.PictureEffects(1).EffectParameters("SharpenSoften").Value = 90

Erreur: Index de cette collection est en dehors dse limite

Temjeh

 

[mromain]

Re : Modification d'image

Re bonjour,

Il y avait une erreur effectivement. Essaye avec 0.9.

A+

 

[Temjeh]

Re : Modification d'image

Bonjour

Désolé même erreur:

For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then
sh.PictureFormat.ColorType = msoPictureGrayscale
sh.Fill.PictureEffects(1).EffectParameters("Sharpe nSoften").Value = 0.9
End If
Next

Temjeh

 

[mromain]

Re : Modification d'image

Bonsoir,

Chez moi, je n'ai pas de souci avec ton code si j'enlève l'espace entre Sharpe et nSoften.
Sinon, essaye comme ça :

sh.Fill.PictureEffects(1).EffectParameters(1).Value = 0.9

Si ça ne marche toujours pas, je pense que tu devras mettre un fichier exemple.

A+

 

[Temjeh]

Re : Modification d'image

Merci

Non tjrs même erreur

Voici en pj

Merci de ton temps

Temjeh

 

[mromain]

Re : Modification d'image

Bonjour Temjeh, le forum,

Essaye ainsi :

Private Sub CommandButton1_Click()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
        If sh.Type = msoPicture Then
            sh.PictureFormat.ColorType = msoPictureGrayscale
            sh.Fill.PictureEffects.Insert(msoEffectSharpenSoften).EffectParameters("SharpenSoften").Value = 0.9
        End If
    Next
End Sub

A+

 

[Temjeh]

Re : Modification d'image

Impeccable

Merci beaucoup

Si j'aimerais l'applique a la shape selectionnée? ...aulieu de tous

Merci

 

[mromain]

Re : Modification d'image

Bonsoir,

Voici un essai avec ce code :

Public Sub CommandButton1_Click()
Dim sh As Shape
    If TypeName(Selection) <> "Picture" Then Exit Sub
    Set sh = Selection.ShapeRange(1)
    sh.PictureFormat.ColorType = msoPictureGrayscale
    sh.Fill.PictureEffects.Insert(msoEffectSharpenSoften).EffectParameters("SharpenSoften").Value = 0.9
End Sub

Par contre, la macro travaillant sur la sélection active (l’image sélectionnée), il faut empêcher la sélection du CommandButton1 en mettant sa propriété TakeFocusOnClick à False.

A+