[ RESOLU ] Obtenir un schéma de principe selon un tableau

[polobeg]

Bonjour à vous tous,

Je me retourne une fois de plus vers vous car pleinement satisfait des réponses obtenues précédemment.

Voici ma demande j'aimerai savoir si cela est possible d'avoir un schéma de principe d'apres des images selon un tableau qui est préalablement rempli.

Je joints un fichier excel qui sera sans aucun doute plus parlant.

Merci d'avance à tous ceux qui y regarderont
Cordialement 🙂

 

[polobeg]

Re : Obtenir un schéma de principe selon un tableau

Bonjour,

j'ai testé de recopier vos exemples sur un fichier à coté mais je n'arrive pas à votre résultat et je ne trouve pas mon erreur.

Pouvez vous m'aider ?

Cordialement

 

[job75]

Re : Obtenir un schéma de principe selon un tableau

Bonjour polobeg,

Puisque vous n'êtes pas capable d'adapter le code, contentez-vous du fichier que j'ai déposé.

A+

 

[job75]

Re : Obtenir un schéma de principe selon un tableau

Re,

J'ai regardé de plus près, il n'y a qu'une ligne de code à modifier dans votre fichier.

lig = Val(Mid(Sh.Name, 7)) + 2

était valable pour les feuilles nommées "Groupe 1", "Groupe 2"...

Avec les feuilles nommées "rv 1", "rv 2" utiliser :

lig = Val(Mid(Sh.Name, 3)) + 2

A+

 

[polobeg]

Re : Obtenir un schéma de principe selon un tableau

Oui en y regardant ce week end j'ai compris que j'avais une erreure dans les feuilles nommées

Du coup j'ai testé avec groupe et cela fonctionne parfaitement
j'ai pu ce matin reproduire tout ce travail sur mon fichier dit " officiel " et tout à l'air de fonctionner pour le mieux.

Je vous remercie enormement Job pour toute les solutions que vous avez pu apporté à mon projet, grace à vous en deux sujet j'ai appris beaucoup et je pense que cela va me re-servir tres vite.

Encore merci et à tout ceux qui auront regardé et proposé pour ce sujet.
Forum en or.

Cordialement Polobeg 😉

 

[job75]

Re : Obtenir un schéma de principe selon un tableau

Bonsoir à tous,

J'ai reçu de polobeg le MP suivant :

Un dernier point si je peux me permettre
pouvez vous m'expliquer comment faire pour inverser le " sens de gravité "
c'est à dire que sur tout les fichiers les images se collent à partir du haut du rectangle comment faire pour que le elle se collent " copie " a partir du bas du rectangle ?

Comme ça peut intéresser d'autres personnes je joins le fichier (7) avec cette macro complétée :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Groupe*" Then Exit Sub
Dim zone As Range, lig&, x#, y#, s As Shape
Set F = Feuil1 'CodeName
Set zone = Sh.[B3:E27] 'zone des Shapes, à adapter
lig = Val(Mid(Sh.Name, 7)) + 2
Application.ScreenUpdating = False
'---RAZ---
For Each s In Sh.Shapes
  If Not Intersect(s.TopLeftCell, zone) Is Nothing _
    And s.Name <> "Rectangle 1" Then s.Delete
Next
'---initialisation---
With Sh.Shapes("Rectangle 1")
  .Left = zone(1).Left + 0.1
  .Top = zone(1).Top + 0.1
  .Width = zone.Width - 0.2
  .Height = zone.Height - 0.2
  .Visible = False
End With
x = zone(1).Left + 16
y = zone(1).Top + 16
'---Copies des Shapes à adapter---
CopieShape F.[L4:N4], lig, F.Shapes("Picture 66"), x, y, "Réhausse", F.[S7], 0
CopieShape F.[K4], lig, F.Shapes("Picture 63"), x, y, "Dalle", F.[S9], 0
CopieShape F.[F4:J4], lig, F.Shapes("Picture 67"), x, y, "TR", F.[S13], 0
CopieShape F.[C4:E4], lig, F.Shapes("Picture 64"), x, y, "ED", F.[S18], 0
If y > zone(1).Top + 16 Then
  CopieShape F.[B4], lig, F.Shapes("Picture 65"), x, y, "FDR ht", F.[S24], 1
  Sh.Shapes("Rectangle 1").Visible = True
  If y > zone(1).Top + zone.Height - 16 Then
    '---ajustement de la hauteur du groupe à la zone des Shapes---
    For Each s In Sh.Shapes
      If Not Intersect(s.TopLeftCell, zone) Is Nothing Then s.Select False
    Next
    With Selection.ShapeRange.Group 'groupage
      .Height = zone.Height - 0.2
      .Ungroup
    End With
  Else
    '---positionnement des shapes en bas de zone---
    For Each s In Sh.Shapes
      If Not Intersect(s.TopLeftCell, zone) Is Nothing _
        And s.Name <> "Rectangle 1" Then s.Select False
    Next
    With Selection.ShapeRange.Group 'groupage
      .Top = zone(1).Top + zone.Height - .Height - 16
      .Ungroup
    End With
  End If
  ActiveCell.Activate
End If
Application.ScreenUpdating = True
End Sub

Bonne soirée.

 

[polobeg]

Re : Obtenir un schéma de principe selon un tableau

Cela à l'air tellement simple pour vous

Merci Forum Merci Job