IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Créer un trait double [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre régulier
    Homme Profil pro
    Inscrit en
    Juillet 2011
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Juillet 2011
    Messages : 8
    Par défaut Créer un trait double
    Bonjour,

    Je travaille actuellement sur un projet dans lequel j'utilise des macro pour créer des configurations de trait différentes. Voici mon code pour créer un trait rouge épaisseur 2 sans transparence.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
     
    ActiveSheet.Shapes.AddLine(15309.75, 6#, 15351.75, 6#).Select
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Line.ForeColor.RGB = RGB(204, 0, 0)
        Selection.ShapeRange.Line.Transparency = 0
        Selection.ShapeRange.Line.Visible = msoTrue
        Selection.ShapeRange.Line.Weight = 2
        Selection.ShapeRange.Line.DashStyle = msoLineSolid 'Trait plein
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.SetShapesDefaultProperties
        Selection.ShapeRange.Line.Visible = msoTrue
    Je voudrais créer un trait double mais je ne trouve pas le code qui me permettrait de le réaliser. Quelqu'un à peut être une idée?

    Merci par avance.

  2. #2
    Invité
    Invité(e)
    Par défaut Création d'un objet shape double traits.
    Bonjour,

    Sauf erreur de ma part, je n'ai pas vu la possibilité de créer un double trait comme dans les bordures par exemple. Dans votre cas, une solution simpliste serait de créer un rectangle.

    Sinon, ci-dessous, le genre de code que j'utilise pour créer mes objets. Le principe est de créer deux traits espacés d'une distance à votre convenance et une fois groupés ils pourront prendre les différentes propriétés souhaitées y compris l'angle de rotation.

    Le soucis pour réaliser un groupement, c'est qu'il ne faut pas de nom en double. La fonction jointe permet de connaître l'indice du dernier objet de même type existant sur la feuille et d'incrémenter de 1 cet indice.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
     
    Sub TestCreerUnDoubleTrait()
     
        CreerUnDoubleTrait 10, 6, 200, 6, 5, 0, 2
     
    End Sub
     
    Sub CreerUnDoubleTrait(ByVal PosH1 As Single, ByVal PosV1 As Single, ByVal PosH2, ByVal PosV2 As Single, ByVal Espacement As Single, ByVal AngleObjet As Single, ByVal EpaisseurTrait As Single)
     
    Dim Nom1 As Variant
    Dim Nom2 As Variant
    Dim ObjetRange As ShapeRange
    Dim NbTraitsExistants As Long
     
        NbTraitsExistants = NbObjetsExistants("Trait ")
     
        ActiveSheet.Shapes.AddLine(PosH1, PosV1, PosH2, PosV2).Select
        Selection.Name = "Trait " & CStr(NbTraitsExistants) & "1"
        Nom1 = Selection.Name
     
        ActiveSheet.Shapes.AddLine(PosH1, PosV1 + Espacement, PosH2, PosV2 + Espacement).Select
        Selection.Name = "Trait" & CStr(NbTraitsExistants) & "2"
        Nom2 = Selection.Name
     
        Set ObjetRange = ActiveSheet.Shapes.Range(Array(Nom1, Nom2))
        ObjetRange.Group.Select
     
        With ObjetRange
             .Name = "Trait " & CStr(NbTraitsExistants)
             .ZOrder msoBringToFront
             .Fill.Visible = msoFalse
             .Line.ForeColor.RGB = RGB(204, 0, 0)
             .Line.Transparency = 0
             .Line.Weight = EpaisseurTrait
             .Rotation = AngleObjet
        End With
     
        Set ObjetRange = Nothing
     
    End Sub
     
    Function NbObjetsExistants(ByVal NomObjet As String) As Long
     
    Dim ItemShape As Shape
     
        NbObjetsExistants = 0
        For Each ItemShape In ActiveSheet.Shapes
         If Len(ItemShape.Name) >= Len(NomObjet) Then
            If Mid(ItemShape.Name, 1, Len(NomObjet)) = NomObjet Then
                    On Error Resume Next
                    NbObjetsExistants = CLng(Mid(ItemShape.Name, Len(NomObjet) + 1))
            End If
         End If
        Next ItemShape
        NbObjetsExistants = NbObjetsExistants + 1
     
    End Function
    Cordialement.

  3. #3
    Membre régulier
    Homme Profil pro
    Inscrit en
    Juillet 2011
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Juillet 2011
    Messages : 8
    Par défaut Création d'un objet shape double traits.
    Bonjour,

    Merci pour cette proposition. Elle serait super si mes traits n'étaient que droit.
    Le problème c'est que le double trait symbolise un fourreau autour d'un cable électrique donc tracé rarement rectiligne.

    Le cadre votre proposition pour le moment mais je cherche encore.

    Cordialement

  4. #4
    Invité
    Invité(e)
    Par défaut
    Dans ce cas, il vous faudra travailler avec des formes

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    ActiveSheet.Shapes.BuildFreeform
    Cordialement.

  5. #5
    Membre régulier
    Homme Profil pro
    Inscrit en
    Juillet 2011
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Juillet 2011
    Messages : 8
    Par défaut
    Avec cette fonction, il faut rentrer toutes les coordonnées mais je ne l'ai connais pas par avance.

    Cela me semble donc compliqué

    Merci qu'en même.

  6. #6
    Membre éclairé
    Homme Profil pro
    Retraité
    Inscrit en
    Novembre 2008
    Messages
    704
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine Maritime (Haute Normandie)

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Novembre 2008
    Messages : 704
    Par défaut
    xlUnderlineStyleDouble

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. créer un trait entre deux clics de souris
    Par doudouded dans le forum VB.NET
    Réponses: 2
    Dernier message: 24/10/2012, 21h35
  2. Créer un trait sans retour à la ligne
    Par franklin19 dans le forum Mise en page CSS
    Réponses: 2
    Dernier message: 22/08/2011, 18h27
  3. [AC-2007] Créer un formulaire à double entrée
    Par touftouf57 dans le forum IHM
    Réponses: 1
    Dernier message: 19/12/2009, 09h03
  4. Réponses: 1
    Dernier message: 23/03/2009, 18h16
  5. [VB2005] Comment créer un bouton double fonction
    Par crashdown31 dans le forum Windows Forms
    Réponses: 13
    Dernier message: 18/09/2006, 08h14

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo