Remise a zéro, flèche... autour d'un dessin

CISCO · 23 Décembre 2013

Bonjour à tous

En pièce jointe, vous trouverez le schéma de principe d'une chaudière murale. Dans chacune des cellules encadrées en bleu, il y a une liste déroulante permettant d'indiquer le nom de l'objet désigné par la flèche. La liste déroulante est actualisée au fur et à mesure en fonction des noms déja sélectionnés sur la feuille. Plus on rempli les cellules bleues, moins la liste est longue, mais il y a quelques intitulés en trop.

Ce n'est pas au point pour diverses raisons :
* les intitulés longs débordent de la cellule, et parfois sur le dessin, ce qui rend l'ensemble peu lisible.
* par endroit, il y a trop de cellules à remplir, ce qui fait que le résultat est peu lisible.

Pour résoudre ces deux problèmes, il me faudra peut être redimensionner certaines parties du dessin.

Pour que cela soit plus pratique, cela serait bien si il y avait un bouton permettant de remettre à zéro (blanc) tous les intitulés dans les cellules bleues. Quelqu'un pourrait-il me monter comment faire ?

@ plus

BOISGONTIER · 23 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour,

Cells.SpecialCells(xlCellTypeAllValidation) = ""

JB

Regueiro · 23 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonsoir à Tous CISCO, Boisgontier
Une autre variante avec l'insertion de légende encadrée
Lorsque tu cliques sur une légende cela ouvre USF1
Dans l'USF1 Textbox1 avec la valeur du texte actuel ou un nouveau choix dans un Combobox1.
Si la valeur du Combobox1 est différente de Textbox1, alors on récupère dans la légende le nouveau Texte.

Code à améliorer.
Encore merci à BOISGONTIER et son site.

A+

CISCO · 23 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonsoir à tous, bonsoir JB et Regueiro

Merci à vous deux.

@ Boisgontier.
Etant nul en macro, malgré quelques tentatives il y a deux ou trois années de cela (de plus j'ai tout oublié depuis), je ne sais pas utiliser ta proposition...

@ Regueiro
Cette possibilité me premettrait de positionner plus astucieusement les intitulés. Toutefois, quelques questions :
* Pour le moment, lorsque je clique sur ces légendes, je n'obtiens pas d'USF. Pourquoi ?
* Peut-on mettre une liste déroulante dans ces légendes encadrées ?
* Cette liste déroulante peut-elle évoluer en éliminant au fur et à mesure les intitulés déja sélectionnés ?

@ plus

Regueiro · 23 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Re
Sur mon PC le USF1 apparaît sans problème.

Pour la question N°2 et 3, je regarde

A+

CISCO · 23 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonsoir

@ Regueiro : Maintenant j'ai un message d'erreur 438 et quand je débugue la macro, cela bloque sur UserForm1.Show dans Sub OuvreUSF1().

@ plus

P.S : Parfois, j'ai aussi le message Erreur d'exécution 2147417848(80010108) : La méthode 'Characters' de l'objet 'Textframe' a échoué.

Regueiro · 24 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Re
Regarde la vidéo sur ce lien :

[video=youtube;w2I7VgjcboI]http://www.youtube.com/watch?v=w2I7VgjcboI[/video]

Je n'ai pas de problème sur mon PC

PC = Portable Microsoft Surface Pro
Windows 8- 64 bits
Excel 2013 - 32 bts
A+

CISCO · 24 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour à tous, bonjour Regueiro

Merci pour la vidéo. Je viens de tester sur un autre ordinateur, et cela fonctionne. Je vais essayer de comprendre les macros. Elles sont courtes, mais bon, vu mon niveau... Déjà une question : A quoi servent les valeurs en feuille 3 ?

@ plus

CISCO · 24 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour à tous

En fouillant sur le forum, et en utilisant la proposition de J. Boisgontier, j'y suis aussi arrivé, mais je n'arrive pas à redimensionner le Commandbutton. Quelle est l'astuce, SVP ?

@ plus

Regueiro · 24 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour à tous, CISCO.
Je suis content que cela marche également chez toi.
Les valeurs sur la feuille 3, sont obtenus avec la macro suivante :

Code:

Sub RecupTexteShapes()
   ligne = 3
   For Each s In Sheets("Feuil1").Shapes
   If s.Type = 2 Then
   
     Cells(ligne, 1) = s.Name
     Cells(ligne, 2) = s.TextFrame.Characters.Text
     Cells(ligne, 3) = s.TopLeftCell.Address
     Cells(ligne, 4) = s.Type
         ligne = ligne + 1
     End If
     
   Next s
 End Sub

Elle récupère les noms des shapes de type 2 qui sont sur la feuille1.
Le Nom du Shape, le texte à l'intérieur du Shape, l'adresse et le type.

L'autre macro tu peux la supprimer, c'était un essai.

Code:

Sub shapestype()
   i = 3
   'For Each s In ActiveSheet.Shapes
    For Each s In Sheets("Feuil1").Shapes
    
    Cells(i, 1) = s.Type
    Cells(i, 2) = s.Name
    i = i + 1
   Next s
 End Sub

Concernant le commanbutton (B-Ok) dans le USF1, il faut élargir le USF1 en premier lieu.
A+

CISCO · 25 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour

C'est bon pour le redimensionnement du CommandButton. Merci Regueiro.

@ plus

CISCO · 25 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonsoir à tous

CISCO à dit:
Bonsoir à tous, bonsoir JB et Regueiro

* Cette liste déroulante peut-elle évoluer en éliminant au fur et à mesure les intitulés déja sélectionnés ?

@ plus

Et pour cela, quelqu'un aurait il une idée ?

@ plus

CISCO · 26 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour à tous

@ Regueiro : Où indiques tu la liste des intitulés à afficher dans la ComboBox1 placé sur l'Userform1? Je cherche dans les macro, dans le descriptif de l'USF, de la ComboBox, mais je ne trouve pas... La liste affichée pourrait-elle ne pas donner les intitulés déjà placés sur la feuille 1 ?

@ plus

Regueiro · 26 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonjour à Tous, CISCO
Voir Fichier en PJ

Commentaires :
La combobox1 de USF1 et maintenant alimenter par la Feuil3 :

Code:

Private Sub UserForm_Initialize()
With Me
.StartUpPosition = 3
.Left = 640
.Top = 30
End With

    Set F = Sheets("Feuil3")
   Set mondico = CreateObject("Scripting.Dictionary")
   
   'ICI LISTE POUR COMBOBOX
   a = F.Range("H3:H" & F.[H65000].End(xlUp).Row)   ' tableau a(n,1) pour rapidité
   For i = LBound(a) To UBound(a)
     If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
   Next i
   '--avec tri
   temp = mondico.keys
   Call tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox1.List = temp

ActiveSheet.Shapes(Application.Caller).Select
  If Selection.ShapeRange.Type = 2 Then
  Montext = Selection.ShapeRange.TextFrame.Characters.Text
  With UserForm1
  .TextBox1.Value = Montext
  .Label1.Caption = Sheets("Feuil3").[H2].Value & vbCrLf & "Nombre " & Sheets("feuil3").[I2].Value
  End With
  End If
End Sub

Lorsque tu click le commandbuton "B_ok"
L'action déclenche également 2 macros.
1. Call RecupTexteShapes
Elle récupère le texte des Shapes de la Feuil1 et les copier sur la Feuil3

Code:

Sub RecupTexteShapes()
   ligne = 3
   For Each s In Sheets("Feuil1").Shapes
   If s.Type = 2 Then
   Set F = Sheets("Feuil3")
     F.Cells(ligne, 1) = s.Name
     F.Cells(ligne, 2) = s.TextFrame.Characters.Text
     F.Cells(ligne, 3) = s.TopLeftCell.Address
     F.Cells(ligne, 4) = s.Type
     ligne = ligne + 1
     End If
   Next s
 End Sub

2. Call DiffBD1BD2
Cette macros compare les valeurs de la Feuil2 Colonne F
X = Valeurs de Feuil2.Range(F2:F...)
avec les valeurs de la Feuil3 Range B3:B1000.
Y = Valeurs de Feuil3.Range(B3:B1000)
Et copie en H2 de la Feuil3 les valeurs X - Y

Code:

Sub DiffBD1BD2()
   ligneEcrit = 3
   nblignes = Sheets("Feuil2").[F65000].End(xlUp).Row + 1
   For i = 2 To nblignes
     x = Sheets("Feuil2").Cells(i, 1)
     If IsError(Application.Match(x, Sheets("Feuil3").[B3:B1000], 0)) Then
        Set F = Sheets("Feuil3")
        F.Cells(ligneEcrit, 8) = x
        ligneEcrit = ligneEcrit + 1
      End If
    Next i
    'Trie des données sur la feuille3 en colonne H
    
    Sheets("Feuil3").[H2].Sort key1:=Sheets("Feuil3").[H3], Order1:=xlAscending, Header:=xlGuess
End Sub

Voilà, j'ai essayé d'être le plus clair possible.
Je pense que l'on peut encore l'améliorer.
Je regarde dans l'après-midi.
Si BOISGONTIER passe par là il va reconnaître certains de ces codes.
A+

CISCO · 26 Décembre 2013

Re : Remise a zéro, flèche... autour d'un dessin

Bonsoir à tous, bonsoir Regueiro

Merci, ça fonctionne. Je vais essayer de comprendre tout cela.

@ plus

Effectuez une recherche sur Excel Downloads...

Remise a zéro, flèche... autour d'un dessin

CISCO

XLDnaute Barbatruc

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

Pièces jointes

CISCO

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

Pièces jointes

CISCO

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

CISCO

XLDnaute Barbatruc

CISCO

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

CISCO

XLDnaute Barbatruc

CISCO

XLDnaute Barbatruc

CISCO

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

Pièces jointes

CISCO

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée