SHAPE oh! my SHAPE

xhudi69 · 2 Avril 2013

Bonsoir le Forum,

A l'aide de l'UserForm, vous sélectionné un Shape bleu puis "sélection", puis vous sélectionné un autre Shape bleu puis "sélection" et ensuite "relier", là ça fonctionne.

Mais si vous sélectionné un Shape bleu et un Shape bleu/rouge, cela ne fonctionne pas 😕 , car le Shape bleu/rouge a été groupé. avez-vous une solution, car je démarre dans les Shapes pour un log à mon travail.

Grand merci à vous tous pour le temps passé.

@+ 😎

BOISGONTIER · 2 Avril 2013

Re : SHAPE oh! my SHAPE

Bonsoir,

Il ne faut pas sélectionner le groupe mais le shape.

http://boisgontierjacques.free.fr/fichiers/jb-organigramme.xls

JB

xhudi69 · 2 Avril 2013

Re : SHAPE oh! my SHAPE

Bonsoir BOISGONTIER, le Forum,

Excellent fichier ! , je m'inspire assez souvent de votre site pour créer des macros, merci encore.
Mais mon soucis est plus ardu, en fait les groupe de Shapes sont des assemblages donnant des symboles électriques, quelle serait la meilleur solution sans perdre en définition ?, je pensait faire des copies d'écran (Bof !) ou en faire des images jpeg ?

A votre avis?, merci pour votre réponse et pour l'ensemble de votre travail.

@+

BOISGONTIER · 2 Avril 2013

Re : SHAPE oh! my SHAPE

Rien n'empêche de cliquer sur un shape d'un groupe pour effectuer le lien.
Sur l'exemple envoyé dans le post#2, les photos sont groupées avec des textes. les liens sont faits sur les photos de chaque groupe photo/texte.
Pourquoi ne pas effectuer le lien par programme?

JB

xhudi69 · 2 Avril 2013

Re : SHAPE oh! my SHAPE

RE:

Effectivement, je pourrais Clicker sur un connecteur d'entrée de Disjoncteur et de relier, je vous joint mon fichier test avec un Disjoncteur Differrentiel, jai fait l'essais et ce n'est pas très concluant en ce sens que le connecteur Elbow ne se place pas correctement.
Pouvez-vous m'aider ou si vous avez une autre solution

Merci encore une fois.

@+

Oupps, j'ai croisé votre correction, je vais étudié de près votre macro concernant les photos avec du texte.

BOISGONTIER · 2 Avril 2013

Re : SHAPE oh! my SHAPE

En utilisant directement l'interface Excel Insertion/Connecteur?

Code:

Sub ListeItemsGroupe()
  For i = 1 To ActiveSheet.Shapes("zt2g").GroupItems.Count
     MsgBox ActiveSheet.Shapes("zt2g").GroupItems(i).Name
  Next i
End Sub

JB

xhudi69 · 2 Avril 2013

Re : SHAPE oh! my SHAPE

RE:

Il est évidant que cela simplifierait les choses, mais je fait actuellement un log de schéma électrique le plus automatisé possible, sans recours à l'interface Excel, ma bibliothèque est bien avancée, les modules, les étiquettes, les additions de folios, les cartouches etc etc
théoriquement il sera possible de créer un schéma unifilaire en un temps reccord (du moins c'est mon souhait), donc si l'on passe par l'interface Excel.........

Merci pour votre éclairage. 😎

@+

xhudi69 · 3 Avril 2013

Re : SHAPE oh! my SHAPE

Bonsoir BOISGONTIER, le Forum,

Merci pour ce bout de code, je poursuit ma quète du Shape, je m'appuie sur votre code pour déterminer quel connecteur se trouve en position haute ou basse pour la connection avec d'autres modules.

La difficulté est que l'on ne peut pas le faire car les connecteur ne touchent pas les bord du Shape et donc n'ont pas la même adresse que celui-ci.

Code:

Private Sub CommandButton2_Click()
With Selection
    a = Selection.TopLeftCell.Address
    
   For i = 1 To ActiveSheet.Shapes("DISJONCTEUR").GroupItems.Count
      If ActiveSheet.Shapes("DISJONCTEUR").GroupItems(i).TopLeftCell.Address = a Then
        TextBox1.Value = ActiveSheet.Shapes("DISJONCTEUR").GroupItems(i).Name
      End If
   Next i
End With
End Sub

Ce code fonctionne bien sur des Shapes rectangles imbriqués par Ex. mais le connecteur ne touchant pas le bord, il n'a pas la même adresse.

Avez-vous une idée ?

@+

BOISGONTIER · 4 Avril 2013

Re : SHAPE oh! my SHAPE

Bonjour,

Je ne sais pas si cela peut servir

Code:

Sub listeItemsGroupe()
   nomGroupe = "DISJONCTEUR_diff"
   For i = 1 To ActiveSheet.Shapes(nomGroupe).GroupItems.Count
     Cells(i + 1, 1) = ActiveSheet.Shapes(nomGroupe).GroupItems(i).Name
     Cells(i + 1, 2) = ActiveSheet.Shapes(nomGroupe).GroupItems(i).Type
     Cells(i + 1, 3) = ActiveSheet.Shapes(nomGroupe).GroupItems(i).TopLeftCell.Address
   Next i
End Sub

Sub degrouper()
    ActiveSheet.Shapes.Range(Array("DISJONCTEUR_DIFF")).Ungroup
End Sub

Sub adresseDegroupé()
   For i = 1 To 10
     tmp = Cells(i + 1, 1)
     Cells(i + 1, "D") = ActiveSheet.Shapes(tmp).TopLeftCell.Address
   Next i
End Sub

Sub grouper()
  Dim a()
  a = Application.Transpose([A2:A11])
  ActiveSheet.Shapes.Range(a).Group.Name = "DISJONCTEUR_DIFF"
End Sub

JB
-

xhudi69 · 6 Avril 2013

Re : SHAPE oh! my SHAPE

Bonsoir BOISGONTIER, le Forum,

En PJ, la solution pour laquelle j'ai opté. Il suffit de rajouter par dessus la forme définitive un autre Shape en recouvrement et de les grouper.
Puis dans la macro, il faut définir le "Sous Shape" et le tour est joué, enfin j'espère 😛

En démo sur l'UserForm les TextBox sont volontairement mises pour illustrer la manip.

Si vous avez une autre idée, je suis preneur.

@+

Merci BOISGONTIER de m'avoir orienté 😎

BOISGONTIER · 7 Avril 2013

Re : SHAPE oh! my SHAPE

Bonjour,

Connexion entre 2 groupes sans l'interface graphique.

-Chaque groupe contient un rectangle
-La connexion se fait par le rectangle

Code:

Sub Connection2()
  Set f = Sheets("feuil1")
  groupe1 = "disjoncteur"
  groupe2 = "disjoncteur_diff"
  nom1 = Rectangle(f, groupe1)
  nom2 = Rectangle(f, groupe2)
  nomCnn = "cnn" & groupe1 & groupe2
  f.Shapes.AddConnector(msoConnectorElbow, 10, 10, 10, 10).Name = nomCnn
  f.Shapes(nomCnn).ConnectorFormat.BeginConnect f.Shapes(nom1), 3
  f.Shapes(nomCnn).ConnectorFormat.EndConnect f.Shapes(nom2), 1
End Sub

Function Rectangle(f, nomGroupe)
   For i = 1 To f.Shapes(nomGroupe).GroupItems.Count
    If f.Shapes(nomGroupe).GroupItems(i).Type = 1 Then
      Rectangle = f.Shapes(nomGroupe).GroupItems(i).Name
    End If
   Next i
End Function

JB

xhudi69 · 7 Avril 2013

Re : SHAPE oh! my SHAPE

Bonjour BOISGONTIER, le Forum,

Grand merci pour ce code, je vais l'analyser et voir si je peux adapter, je me rends compte qu'il y a beaucoup de variables, une de plus (à venir) pour la position des Shapes entre eux, se qui déterminera le point de jonction du connecteur, si Sh1 est plus haut que Sh2 alors on connecte point 3 de Sh1 avec point 1 de Sh2.

Merci et @+ 😎

BOISGONTIER · 7 Avril 2013

Re : SHAPE oh! my SHAPE

Code:

Sub Connection2()
  Set f = Sheets("feuil1")
  groupe1 = "disjoncteur"
  groupe2 = "disjoncteur_diff"
  nom1 = Rectangle(f, groupe1)
  nom2 = Rectangle(f, groupe2)
  nomCnn = "cnn" & groupe1 & groupe2
  f.Shapes.AddConnector(msoConnectorElbow, 10, 10, 10, 10).Name = nomCnn
  If ligne(f, groupe2) > ligne(f, groupe1) Then typeCnn1 = 3: typeCnn2 = 1 Else typeCnn1 = 1: typeCnn2 = 3
  f.Shapes(nomCnn).ConnectorFormat.BeginConnect f.Shapes(nom1), typeCnn1
  f.Shapes(nomCnn).ConnectorFormat.EndConnect f.Shapes(nom2), typeCnn2
End Sub

Function Rectangle(f, nomGroupe)
  For i = 1 To f.Shapes(nomGroupe).GroupItems.Count
   If f.Shapes(nomGroupe).GroupItems(i).Type = 1 Then
     Rectangle = f.Shapes(nomGroupe).GroupItems(i).Name
   End If
  Next i
End Function

Function ligne(f, nomGroupe)
  ligne = Range(f.Shapes(nomGroupe).TopLeftCell.Address).Row
End Function

JB

xhudi69 · 7 Avril 2013

Re : SHAPE oh! my SHAPE

Bonjour BOISGONTIER, le Forum

Ce code est plus simple que le mien et fonctionne très bien, il faut que je refasse ma bibliothèque 😉 .

Un grand merci, grace à vous j'avance un peu plus, il me reste à adapter à mon projet, j'ai du pain sur la planche 😛

Je reviens dès que possible.

@+ 😎

BOISGONTIER · 7 Avril 2013

Re : SHAPE oh! my SHAPE

Version avec formulaire (Ajout/Suppression)

Code:

Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("feuil1")
  For Each c In f.Shapes
    If c.Type = 6 Then
      Me.ComboBox1.AddItem c.Name
      Me.ComboBox2.AddItem c.Name
    End If
  Next c
End Sub

Private Sub B_connext_Click()
  groupe1 = Me.ComboBox1
  groupe2 = Me.ComboBox2
  nomShape1 = Rectangle(f, groupe1)
  nomShape2 = Rectangle(f, groupe2)
  nomCnn = "cnn" & groupe1 & groupe2
  f.Shapes.AddConnector(msoConnectorElbow, 10, 10, 10, 10).Name = nomCnn
  If ligne(f, groupe2) > ligne(f, groupe1) Then typeCnn1 = 3: typeCnn2 = 1 Else typeCnn1 = 1: typeCnn2 = 3
  f.Shapes(nomCnn).ConnectorFormat.BeginConnect f.Shapes(nomShape1), typeCnn1
  f.Shapes(nomCnn).ConnectorFormat.EndConnect f.Shapes(nomShape2), typeCnn2
End Sub

Private Sub B_sup_cnn_Click()
  On Error Resume Next
  groupe1 = Me.ComboBox1
  groupe2 = Me.ComboBox2
  nomShape1 = Rectangle(f, groupe1)
  nomShape2 = Rectangle(f, groupe2)
  nomCnn = "cnn" & groupe1 & groupe2
  f.Shapes.Range(Array(nomCnn)).Delete
End Sub

Function Rectangle(f, nomGroupe)
  For i = 1 To f.Shapes(nomGroupe).GroupItems.Count
   If f.Shapes(nomGroupe).GroupItems(i).Type = 1 Then
     Rectangle = f.Shapes(nomGroupe).GroupItems(i).Name
   End If
  Next i
End Function

Function ligne(f, nomGroupe)
  ligne = Range(f.Shapes(nomGroupe).TopLeftCell.Address).Row
End Function

JB

SHAPE oh! my SHAPE

xhudi69

XLDnaute Accro

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

xhudi69

XLDnaute Accro

BOISGONTIER

XLDnaute Barbatruc

xhudi69

XLDnaute Accro

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

xhudi69

XLDnaute Accro

xhudi69

XLDnaute Accro

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

xhudi69

XLDnaute Accro

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

xhudi69

XLDnaute Accro

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

xhudi69

XLDnaute Accro

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

SHAPE oh! my SHAPE

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency