× Aidez la recherche contre le COVID-19 avec votre ordi ! Rejoignez l'équipe PC Astuces Folding@home
 > Tous les forums > Forum Bureautique
 Cherche infos pour dessiner des Shapes
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
eliot raymondo
  Posté le 23/10/2018 @ 18:57 
Aller en bas de la page 
Petit astucien

Bonsoir a tous, forum bonsoir,

Je recherche un logiciel Fr, tuto Fr pour dessiner des shapes et pour savoir comment ca marche

comment faire pour récupérer les chiffres en rouge dans le code ci dessous.

Ps: le code trouver sur le net représente un triangle plein rouge MAIS moi j'obtiens un rectangle évidé avec des bordures rouge

que l'on peut déplacer avec les flèches du clavier.

Mais ca dépends peut être de la version d'Excel utiliser.

Merci pour l'aide que vous pourrez m'apporter, bonne soirée a vous.

Cdlt Ray

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

ActiveSheet.Shapes("Curseur").Visible = True

If Err <> 0 Then

ActiveSheet.Shapes.AddShape(7, 6, 6, 8, 6).Name = "Curseur"

ActiveSheet.Shapes("Curseur").Fill.ForeColor.SchemeColor = 2

ActiveSheet.Shapes("curseur").IncrementRotation 90

ActiveSheet.Shapes("curseur").Line.Visible = msoFalse

End If

ActiveSheet.Shapes("curseur").Left = Target.Left + 4

ActiveSheet.Shapes("curseur").Top = Target.Top + 2

ActiveSheet.Shapes("curseur").Height = 6

ActiveSheet.Shapes("curseur").Width = 8

End Sub

Publicité
ferrand
 Posté le 24/10/2018 à 00:01 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonsoir,

Ce code est à simplifier (juste un peu lourd...), mais il fabrique bien (s'il ne trouve pas la forme nommée "Curseur" :

- un triangle isocèle (7=msoShapeIsoscelesTriangle, constante préférable pour ne pas avoir à chercher ce que 7 signifie ! ), de largeur =8pts (environ 2,8 mm) et de hauteur =6pts (environ 2,1 mm),

- ce triangle est plus large que haut mais on lui applique une rotation de 90° qui rendra verticale sa base (la plus large), le sommet opposé étant alors à droite, ce qui donne une petite flèche triangluaire orientée vers la droite,

- le fond est coloré en rouge (Fill.ForeColor.RGB = vbRed serait plus au goût du jour dans les nouvelles versions) et le trait rendu invisible.

Mais je ne comprends par bien ce que tu veux par :

comment faire pour récupérer les chiffres en rouge dans le code ci dessous

Ces chiffres mis en rouge sont des paramètres obligatoires de création de forme automatique avec la méthode AddShape.

Tu as l'explication du 1er (type de forme) et des 2 derniers (largeur et hauteur) qui dimensionnent la forme, les 2 intermédiaires sont les coordonnées de positionnement horizontal et vertical. Ils sont indifférents dans ce cas, car la forme va être repositionnée dans la cellule ayant donné lieu au lancement de la procédure, et il eût été plus logique de mettre 0 et 0 pour ces deux paramètres.

Cordialement.

eliot raymondo
 Posté le 24/10/2018 à 08:13 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

Merci pour ta réponse, c'est sympa.

Je cherche des infos pour commencer a créer ce genre de petites applications, donc voila pour moi

un début de réponse et je t'en remercie.

Pour les chiffres a récupérer, je pensais a un logiciel avec lequel on dessine une figure puis quand c'est terminé

on récupère ces valeurs pour les mettre dans le code.

Mais je n'en sais pas plus dans l'immédiat, d'où ce post pour savoir comment ca marche.

Je vais étudier les infos que tu me fourni puis, je vais essayer de trouver un tuto en Fr pour démarrer.

PS: Tu me dis, "Ce code est à simplifier (juste un peu lourd.)" , tu pourrais svp optimiser ce code, merci.

Je te souhaite une bonne et agréable journée.

Cdlt Ray

ferrand
 Posté le 24/10/2018 à 14:30 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Voilà pour la réécriture de la macro :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Me
On Error Resume Next
.Shapes("Curseur").Visible = True
If Err <> 0 Then
With .Shapes.AddShape(msoShapeIsoscelesTriangle, 6, 6, 8, 6)
.Name = "Curseur"
.Fill.ForeColor.RGB = vbRed
.Line.Visible = msoFalse
.IncrementRotation 90
End With
End If
On Error GoTo 0
With .Shapes("curseur")
.Left = Target.Left + 2
.Top = Target.Top + 4
End With
End With
End Sub

Mais logiquement, elle devrait ne s'appliquer qu'au déplacement de la sélection dans une plage de cellules ciblée où l'on veut faire apparaître ce triangle, donc il devrait y avoir une condition préalable sur la position de Target dans la plage visée, et si Target en dehors, mise de la propriété Visible à False.

Tous les objets que l'on peut faire apparaître sur une feuille appartiennent à la collection Shapes. AddShape n'est qu'une des 15 méthodes destinées à générer un objet Shape de nature différente. Cette méthode génère des formes automatiques, c'est à dire prédéfinies, celles qui sont produites manuellement au moyen du menu Insertion > Formes.

Les arguments de la méthode sont le type de la forme qu'on ajoute : tu disposes de constantes VBA de l'énumération msoAutoShapeType, par exemple msoShapeOval ou msoShapeRectangle, mais il y en a une bonne quantité, et il est préférable d'indiquer la constante, qui donne d'emblée une idée de la forme codée, plutôt que sa valeur numérique (on ne peut les retenir toutes !) Et les 4 arguments qui suivent correspondent aux propriétés Left, Top, Width et Height. C'est toi qui décide de ces valeurs selon la forme que tu veux générer, son positionnement et ses dimensions.

Sa mise en forme passe par une multitude d'objets permettant de la définir. Ici on n'en utilise que 3 : objet FillFormat (renvoyé par Fill, mise en forme de l'intérieur), objet LineFormat (renvoyé par Line, mise en forme du contour) et objet ColorFormat (renvoyé par une propriété référant à la couleur, telle ForeColor ou BackColor, permettant de définir la couleur de l'élément). Les mises en forme s'appliquent diversement selon les formes générées... On finit par avoir quelques repères à la longue, mais c'est un véritable maquis que naviguer dans les Shapes, et il y a toujours quelque chose qu'on ignorait à y découvrir...

Bon courage ! Cordialement.



Modifié par ferrand le 24/10/2018 14:31
eliot raymondo
 Posté le 24/10/2018 à 16:04 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

Merci beaucoup pour ces infos, je vais étudier cette lecture.

Je souhaiterai svp une modification, tu m'a mis la puce a l'oreille a propos de cette phrase ci-dessous.

Mais logiquement, elle devrait ne s'appliquer qu'au déplacement de la sélection dans une plage

de cellules ciblée où l'on veut faire apparaître ce triangle, donc il devrait y avoir une condition

préalable sur la position de Target dans la plage visée, et si Target en dehors"

j'aurai bien voulu délimiter une plage de fonctionnement pour le déplacement du curseur.

-- La plage serait donc de (A3:200)

-- Interdiction d'aller en ligne 1 et 2 plage de (A1:J2) interdit réserver a mes entêtes de colonne.

Sinon j'ai tester et adapter le nouveau code que tu a fait et cela fonctionne bien.

Merci pour ton aide, je te souhaite une bonne fin d'après midi.

Je pars en lecture essayer de comprendre tout ça

Cdlt Ray

ferrand
 Posté le 24/10/2018 à 16:33 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Classiquement :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A3:J200")) Is Nothing Then
'code de la macro
Else
On Error Resume Next
Me.Shapes("Curseur").Visible = msoFalse
End If
End Sub

Cordialement.

eliot raymondo
 Posté le 25/10/2018 à 12:16 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

Un peu de retard pour la réponse, désolé, du boulot pas prévu.

J'ai adapter les divers codes et voila c'est bon ca fonctionne bien

et dans la plage voulue, merci pour les modifications.

Je vais essayer de trouver un peu de doc, pour l'instant j'ai juste

ce que tu m'a fourni en infos.

Si svp,tu a d'autres infos, lien, codes VBA ou autres concernant les shapes, je suis preneur, merci

Je te souhaite une bonne journée et vu l'heure un bon app et merci a toi

Cdlt Raymond

eliot raymondo
 Posté le 25/10/2018 à 14:28 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

J'ai remodifier le code pour changer le caractère d'affichage "curseur" (petit triangle rouge).

Par un "rectangle" rouge, ça fait comme une cellule avec les 4 bordures rouges et transparent.

Toutes les colonnes voir svp photo ci-jointe sont "Autofit" donc les colonnes s'adaptent automatiquement

au texte enter dans la cellule.

ça fonctionne presque SAUF que le nouveau curseur rouge ne s'adapte pas a la largeur des colonnes.

Voir sur la photo ligne 17 curseur rouge sur la cellule.

Comment svp peut t'on corriger ce défault.

Merci pour ton aide et bonne après midi a toi.

Cdlt Raymond

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Feuil1.Range("A3:G200")) Is Nothing Then
If Target.Row < 3 Or Target.CountLarge > 1 Then Exit Sub
With Me
.Shapes("Curseur").visible = msoTrue
If Err <> 0 Then
With .Shapes.AddShape(msoShapeRectangle, 6, 6, 8, 6)
.Shapes("Curseur").Fill.Transparency = 1
.Name = "Curseur"
.Line.ForeColor.RGB = vbRed
.Line.visible = msoFalse
.IncrementRotation 90
End With
End If
On Error GoTo 0
With .Shapes("curseur")
.Left = Target.Left
.Top = Target.Top
End With
End With
End If

End sub

Lien vers la photo.

https://www.cjoint.com/c/HJzmACKWf1z

ferrand
 Posté le 26/10/2018 à 17:17 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour,

J'ai réussi à volatiliser mon message d'explications en le mettant en forme, et ppas le temps de le réécrire. Je vais donc résumer :

3 erreurs ou ajustements à régler :

Supprimer cette ligne :

If Target.Row < 3 Or Target.CountLarge > 1 Then Exit Sub

et modifier la ligne précédente :

If Not Intersect(Target.Cells(1, 1), Me.Range("A3:G200")) Is Nothing Then

Seul le cas où la sélection est multicellulaires et sur une ligne <3 est à éliminer. Les autres cas de multisélection n'empêchent d'obtenir le résultat voulu. Et je n'inciterais pas à remplacer Count par CountLarge (dont Microsoft ne fournit aucune explication sur les raisons ayant motivé sa création...)

Modifier les deux dernières lignes de ce qui suit et leur ordre :

With .Shapes.AddShape(msoShapeRectangle, 6, 6, 8, 6)
.Shapes("Curseur").Fill.Transparency = 1
.Name = "Curseur"


.Name = "Curseur"
.Fill.Transparency = 1

On ne peut invoquer une forme nommée "Curseur" si on ne l'a pas auparavant nommée ainsi. On ne peut non plus faire procéder une Shape d'une autre Shape (sous With, même si c'est censé être la même)...

Supprimer cette ligne :

.IncrementRotation 90

et modifier la ligne de création :

With .Shapes.AddShape(msoShapeRectangle, 6, 6, 6, 8)

S'agissant d'un rectangle et non plus d'un triangle, la rotation de 90° ne fait qu'intervertir largeur et hauteur initiales, il suffit donc de faire cette interversion à la création et plus besoin de rotation !

Par ailleurs, le rectangle sur ton image ligne 17 n'est manifestement pas un rectangle de 6 pts de large sur 7 pts de haut ! (une cellule standard fait 60 pts x 15 pts). Il n'a donc pu être produit par cette procédure...

Et si tu veux t'en servir pour encadrer la cellule, la définition d'un contour rouge d'épaisseur moyenne en une ou deux lignes de code sera certainement mieux adaptée.

Cordialement.

Publicité
eliot raymondo
 Posté le 26/10/2018 à 19:20 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

Merci pour les modifications et pour les infos, c'est gentil.

Le code du rectangle rouge provient de Mr Jacques Boisgontier bien connu pour tous ces programmes publier sur le net.

Après j'ai broder un peu dessus.

Pour ce que tu me dit:

Par ailleurs, le rectangle sur ton image ligne 17 n'est manifestement pas un rectangle de 6 pts de large sur 7 pts de haut ! (une cellule standard fait 60 pts x 15 pts). Il n'a donc pu être produit par cette procédure...

Et si tu veux t'en servir pour encadrer la cellule, la définition d'un contour rouge d'épaisseur moyenne en une ou deux lignes de code sera certainement mieux adaptée.

Quand svp tu aura le temps si tu veux bien m'expliquer comment faire pour encadrer la cellule, la définition d'un contour rouge d'épaisseur moyenne en une ou deux lignes de code sera certainement mieux adaptée.

Merci pour ton aide, bonne soirée et bon W-end a toi.

Cdlt Ray



Modifié par eliot raymondo le 26/10/2018 19:21
ferrand
 Posté le 26/10/2018 à 23:51 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Voilà :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Range("A3:J200").Borders.LineStyle = xlLineStyleNone
If Not Intersect(Target.Cells(1, 1), Me.Range("A3:J200")) Is Nothing Then
With Target.Cells(1, 1)
.BorderAround xlContinuous, xlMedium
.Borders.Color = vbCyan
End With
End If
End Sub

La bordure colorée apparaît lorsque la cellule est sélectionnée et disparaît au profit de la nouvelle cellule sélectionnée... Mais durant le temps où la cellule sélectionnée, si la bordure est en rouge elle va apparaître cyan (bleu turquoise). D'où astuce pour qu'on la voie encadrée en rouge, on la colore en cyan (couleur complémentaire).

Cordialement.

eliot raymondo
 Posté le 27/10/2018 à 14:52 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

Merci bien pour le code,

ça ne fonctionne pas très bien, je n'arrive a avoir un curseur bien rouge entoure la bordure de la cellule active et qui suit bien le curseur original

Pas facile a expliquer,

Et puis ca sautille un peu sur l'écran.

je vais continuer mes essais

Bonne après midi et bon W-end a toi.

Cdlt Ray

ferrand
 Posté le 29/10/2018 à 13:26 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour,

Si ça sautille, tu introduis une désactivation de la mise à jour de l'affichage.

Application.ScreenUpdating = False
Me.Range("A3:J200").Borders.LineStyle = xlLineStyleNone

Avant la ligne d'effacement de la bordure existante (éventuellement) car c'est cette commande qui a le plus de chances de provoquer un sautillement.

Si la bordure ne t'apparaît pas assez épaisse, tu peux augmenter l'épaisseur :

.BorderAround xlContinuous, xlThick

Maintenant, si tu trouves que le rouge n'est pas assez rouge, c'est un autre problème, cela relève du calibrage des couleurs affichées sur ton écran...

Il faut aussi noter que tu ne vois que sur la cellule sélectionnée, donc en quelque sorte au travers d'un prisme qui inverse les couleurs...

Cordialement.

eliot raymondo
 Posté le 29/10/2018 à 18:42 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut ferrand,

Merci pour la réponse et pour les informations.

Sinon ça fonctionne, mais le cyan et rouge bof, c'est pas trop top.

Du moins, c'est mon avis, mais c'est toujours mieux que rien

Bonne soirée a toi, merci beaucoup pour ton aide et pour toutes

les informations, codes que tu m'a apporter.

Bonne continuation a toi.

Bien cordialement Raymond

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Les bons plans du moment PC Astuces

Tous les Bons Plans
75,99 €Onduleur APC BE550G-FR à 75,99 €
Valable jusqu'au 12 Août

Amazon fait une promotion sur le très bon onduleur APC BE550G-FR qui passe à 75,99 € livré gratuitement alors qu'on le trouve ailleurs à partir de 90 €. Cet onduleur assure une alimentation de secours sur batteries et une protection contre les surtensions pour votre ordinateur et vos périphériques le temps que vous fermiez et éteignez correctement votre materiel en cas de coupure de courant. Il offre une puissance de sortie de 330W/550 VA et permet jusqu’à 12 minutes d’autonomie à mi-charge et 3,5 min en pleine charge.


> Voir l'offre
35,29 €Compresseur portable autonome Xiaomi Mija à 35,29 €
Valable jusqu'au 11 Août

Gearbest fait une promotion sur le compresseur portable autonome Xiaomi Mija qui passe à 35,29 €. Ce compresseur à emporter facilement avec vous comporte un écran (où vous pourrez choisir la pression à atteindre en PSI ou BAR) une batterie de 2000 mA et vous permettra de gonfler vos jouets (41 pièces avec une charge), pneus de vélo, de trotinette, de moto (6 pneus avec une charge) et même de voiture (5 pneus avec une charge) facilement. Le câble est accompagné d'un embout pour valve Schrader et un adapteur Presta et une aiguille sont fournis. Le compresseur se recharge via une prise Micro USB.

Ce marchand sérieux se trouvant en Chine, la livraison peut prendre une vingtaine de jours. Vous pouvez payer par carte bancaire ou par Paypal (conseillé pour bénéficier de la garantie Paypal).


> Voir l'offre
59,99 €Nintendo Ring Fit Adventure pour Switch à 59,99 €
Valable jusqu'au 11 Août

Amazon fait une promotion sur le Nintendo Ring Fit Adventure pour Switch à 59,99 € livré gratuitement au lieu de 79 €. Faites du sport tout en vous amusant avec Ring Fit Adventure ! Munis des accessoires présents dans la boite du jeu partez à l’aventure et réalisez des mouvements de sports pour avancer dans les niveaux. Poussez sur le Ring-Con et vous enverrez un choc sur vos ennemis ! A la fin de chaque exercice, mesurez même votre rythme cardiaque et découvrez le nombre de calories dépensées.


> Voir l'offre

Sujets relatifs
Je cherche un log pour dessiner des mises en scene
Cherche logiciel gratuit pour couper et recadrer fichier PDF
Cherche un agenda en ICS pour importer agenda Gmail.
Cherche logiciel travail collaboratif en ligne pour gestion de projets
cherche programme de cryptage pour clef USB
quel logiciel pour dessiner un plan?
Cherche petit soft pour créer diagramme
Cherche truc pour compter les caractères
Cherche tuto pour créer vidéo flash interactive
Cherche logicie gratuit pour arbre généalogique
Plus de sujets relatifs à Cherche infos pour dessiner des Shapes
 > Tous les forums > Forum Bureautique