Macro pour colorer une forme libre

Résolu

Limon -
Limon - 7 juil. 2014 à 09:30

Bonjour,
Je suis débutant en VBA. Je désire à l'aide d'une mise en forme conditionnelle colorer une forme libre.
Le message d'erreur suivant apparait "Erreur de compilation End Sub attendu
Ci dessous ma macro. sur Excel 2010 MAC
Merci pour votre aide
Sub Test1()

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("B1").Value = 20000 Then
ActiveSheet.Shapes("Forme libre 2").Fill.ForeColor.SchemeColor = 11

End If
End Sub

Afficher la suite

A voir également:

Macro pour colorer une forme libre
Mise en forme conditionnelle excel - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Mise en forme tableau word - Guide
Libre office en francais - Télécharger - Suite bureautique
Libre office gratuit - Guide

56 réponses

Réponse 21 / 56

Limon

J'essaie cela immédiatement et reviens vers toi si difficulté.
Énorme merci

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

j'ai rectifié le code, petite confusion dans l'interprétation And veut dire et

if [B1]="x" and [B1]="y" then

pour ou il faut donc remplacer And par Or

if [B1]="x" Or [B1]="y" then

Réponse 22 / 56

Limon

Re-bonjour
Toutes les procédures indiquées fonctionnent parfaitement.
Encore merci

Autre question:En lançant ma macro, je souhaite faire apparaître une Zone Texte qui était en blanc et que je veux faire apparaître en noir. Comment identifier en VBA une zone Texte 5 par exemple?

Réponse 23 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

le code pour faire apparaitre une zone de texte
ActiveSheet.Shapes.Range(Array("TextBox 5")).Visible = True

pour masquer une zone de texte
ActiveSheet.Shapes.Range(Array("TextBox 5")).Visible = False

pour la coloriser en noir
ActiveSheet.Shapes("TextBox 5").Fill.ForeColor.RGB = RGB(0, 0, 0)

pour la mettre en blanc
ActiveSheet.Shapes("TextBox 5").Fill.ForeColor.RGB = RGB(255, 255, 255)

Réponse 24 / 56

Limon

Bonjour,

Afin de mettre dans une couleur les bords de 170 formes libres de ma carte j'ai suivi la procédure que tu m'as envoyée. Cette dernière pour Trois formes libres fonctionne bien. Par contre lorsque je la généralise pour les 170 pays une erreur de compilation apparait avec mention "Procédure trop longue".
comment puis je faire?
Ci dessous la procédure reproduite 170 fois
ActiveSheet.Shapes.Range(Array("Forme libre 2")).Select
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)

Merci de ton aide

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 25 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

Ce code colorise les bordures de toutes les shapes de ta feuille et en fin de code, cette ligne recolorise les shapes nommées "Ellipse 2", "Rectangle 3" d'une couleur différente ou les recolorise à l'état initial

ActiveSheet.Shapes.Range(Array("Ellipse 2", "Rectangle 3")).Line.ForeColor.RGB = RGB(255, 0, 0)

Sub CouleurBordureShapes()
Dim img As Object
For Each img In Worksheets(1).Shapes
'ou
'For Each img In Sheets("Feuil1").Shapes
img.Line.ForeColor.RGB = RGB(0, 0, 0)
Next
ActiveSheet.Shapes.Range(Array("Ellipse 2", "Rectangle 3")).Line.ForeColor.RGB = RGB(255, 0, 0)
End Sub

Réponse 26 / 56

Limon

Absolument génial
Et ça fonctionne
Merci

Réponse 27 / 56

Limon

Re Re bonjour,
Tout d'abord encore merci. Toutes les procédures fonctionnent et cela me donne des idées pour améliorer ma macro.
Le code:
ActiveSheet.Shapes.Range(Array("Ellipse 2", "Rectangle 3")).Line.ForeColor.RGB = RGB(255, 0, 0)
permet de contracter les lignes par une mise en parenthèses des formes libres pour coloriser les bordures
Existe t il un code similaires pour contracter les lignes par une mise en parenthèses des formes libres pour coloriser l'intérieur de ces formes libres.
Lorsque j'écris:
If Range("B1").Value = 3 Then ActiveSheet.Shapes("Freeform 1924", "Freeform 1920").Fill.ForeColor.RGB = RGB(255, 255, 153)
cela ne fonctionne pas.

Réponse 28 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

Si ça marche, mais il faut ajouter un Array

If Range("B1").Value = 3 Then ActiveSheet.Shapes.Range(Array("Freeform 1924", "Freeform 1920")).Fill.ForeColor.RGB = RGB(255, 0, 0)

Réponse 29 / 56

Limon

désolé,
Encore une petite question.
Comment puis je traduire e VBA le fait de passer à un agrandissement de ma feuiile excel de 100% à 200%?
Ex:
If Range("B1").Value = 0 Then..... Je passe d'un agrandissement de ma feuille excel de 125% à 200%

Merci

Réponse 30 / 56

Limon

Nos messages se sont croisés.
Merci pour ta première réponse.
Je ne suis qu'un débutant mais avec tes conseils je vais progresser.

Réponse 31 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

comme ça

ActiveWindow.Zoom = 200

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Réponse 32 / 56

Limon

Merci.
J'ai ainsi du travail pour toute la nuit.
Je te remercie très très sincèrement

Réponse 33 / 56

Limon

Encore et toujours plus compliqué:
Existe il un code pour centrer (au centre de la feuille) un groupe de formes libres après un agrandissement de cette feuille ?
Merci

Réponse 34 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

Pour aligner au centre de l'écran, le code est lourd mais il est possible de l'écrire, par contre plus facile à utiliser et pour ramener les formes à leur place ces deux lignes de codes positionnent la forme nommée "Forme libre 2" sur la ligne 20 et colonne 10 soit aligné sur la cellule J20

ActiveSheet.Shapes("Forme libre 2").Left = Cells(20, 10).Left
ActiveSheet.Shapes("Forme libre 2").Top = Cells(20, 10).Top

Réponse 35 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

pour compléter le post précédent et placer toujours la forme au centre de l'écran quelque soit la zone visible
il suffit de régler les valeurs 500 et 200 en fonction de l'écran utilisé, bien évidemment ces valeurs peuvent être automatique mais là le code est coton mais c'est possible

Set ecran = ActiveWindow.VisibleRange
With ActiveSheet
ActiveSheet.Shapes("Forme libre 2").Left = ecran.Left + 500
ActiveSheet.Shapes("Forme libre 2").Top = ecran.Top + 200
End With

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Réponse 36 / 56

Limon

Bonjour,
Au risque de me répéter, encore mille mercis.
J'essaie ces deux procédures

Bonne journée

Réponse 37 / 56

Limon

Re-Bonjour,
La procédure que tu m'as envoyée hier soir fonctionne parfaitement. Merci
Set ecran = ActiveWindow.VisibleRange

With ActiveSheet

ActiveSheet.Shapes("Forme libre 2").Left = ecran.Left + 500

ActiveSheet.Shapes("Forme libre 2").Top = ecran.Top + 200

End With

Question.
Existe il une autre procédure permettant de remettre les forme libre à leur place initiale.
Les forme livre sont des pays. Grace à la macro que j'ai faite à l'aide de tes conseil, un groupe de pays est grossi et centre au milieu de l'écran,. mais je souhaiterais qu'ils puissent ensuite être remis à leur place initiale. Est ce possible?

Merci

Réponse 38 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

et la non, ce que tu demandes est possible dans l'exécution du code, mais dans ton cas c'est impossible parce que tu veux zoomer une pièce puis soit en activant une nouvelle pièce l'ancienne doit revenir à sa place.
je pense que tu devrais tester la position de chaque pièce et à l'activation d'une pièce repositionner chaque pièce avec le code que tu devras tester

With ActiveSheet
ActiveSheet.Shapes("Forme libre 1").Left = ecran.Left + 50
ActiveSheet.Shapes("Forme libre 1").Top = ecran.Top + 20
ActiveSheet.Shapes("Forme libre 3").Left = ecran.Left + 100
ActiveSheet.Shapes("Forme libre 3").Top = ecran.Top + 80

ActiveSheet.Shapes("Forme libre 2").Left = ecran.Left + 500
ActiveSheet.Shapes("Forme libre 2").Top = ecran.Top + 200

ton projet me plait bien, si tu me joint ton fichier j'essayerai de condenser le code

Réponse 39 / 56

Limon

Super Merci
Aucun problème je veux bien te faire parvenir mon fichier.
Mais comment?

Réponse 40 / 56

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

tu clic sur ce lien, Parcourir pour sélectionner le fichier/Créer le lien/coller le lien généré dans un post ou en message privé, pour cela clic sur mon pseudo et écrire un message

https://www.cjoint.com/

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Discussions similaires

alternative à winzip ?

Quel autre logiciel que WinZip choisir ?

Votre réponse

Discussions similaires