Nochmal Controls & FaceId's

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Nochmal Controls & FaceId's
von: ransi
Geschrieben am: 24.04.2005 16:10:36


      
Hallo
folgender code liefert mir eine Übersicht über die Struktur der Controls 
in den Commandbars.
Der code erstellt eine commandbar die sich NICHT selber löscht.
Funktioniert so ganz gut. 
Die FaceIds werden mittlerweile auch abgebildet
Danke nochmal an Ramses und Ha_Jo.
Allerdings habe ich jetzt einen Fehler entdeckt und weiss nicht wo er herkommt.
Unter commandbar Zeichnen->control Zeichnen->control Autoform ändern 
liegen standardmäßig nochmal 5 controls.
Die werden von dem Code leider erfolgreich ignoriert.
Option 
Explicit
Public Sub Zeig_alles()
    
Dim reset As CommandBarControl
    
Dim cb As CommandBar
    
Dim c As CommandBar
    
Dim a As CommandBar 'Zähler
    Dim b As CommandBarControl
    
Dim cneu As CommandBarControl 'neu
    Dim d As CommandBarControl 'Zähler
    Dim e As CommandBarControl 'neu
    Dim f As CommandBarControl 'Zähler
    Dim g As CommandBarControl 'neu
    Dim h As CommandBarControl 'zähler
    Dim i As CommandBarControl 'neu
On Error Resume Next
DoEvents
Application.ScreenUpdating = 
False
For Each cb In Application.CommandBars
If cb.Name = "Alle Infos" Then cb.Delete
Next
Set c = Application.CommandBars.Add(Name:="Alle Infos")
Set b = Application.CommandBars("Alle Infos").Controls.Add(msoControlPopup)
Set reset = Application.CommandBars("Alle Infos").Controls.Add(msoControlButton)
b.Caption = 
"ID's "
With reset 'für Neuberechnung
    .Caption = "Reset"
    .Style = msoButtonIconAndCaption
    .FaceId = 940
    .OnAction = 
"Zeig_alles"
End With
c.Visible = 
True
For Each a In Application.CommandBars
    
If a.Name <> "Alle Infos" Then
        
Set cneu = b.Controls.Add(Type:=msoControlPopup)
                cneu.Caption = a.NameLocal & 
" ID:=" & a.ID
            
For Each d In a.Controls
            
If Not d Is Nothing Then
                    
Set e = cneu.Controls.Add(Type:=d.Type)
                    
With e 'Eigenschaften des Originals abschreiben
                        .Caption = d.Caption & " ID:=" & d.ID
                        .Style = d.Style
                        .FaceId = d.ID
                    
End With
                
End If
                
For Each f In d.Controls
                    
If Not f Is Nothing Then
                        
Set g = e.Controls.Add(Type:=f.Type)
                        
With g 'Eigenschaften des Originals abschreiben
                            .Caption = f.Caption & " ID:=" & f.ID
                            .Style = f.Style
                            .FaceId = f.ID
                        
End With
                    
End If
                    
For Each h In f.Controls
                        
If Not h Is Nothing Then
                            
Set i = g.Controls.Add(Type:=h.Type)
                            
With i 'Eigenschaften des Originals abschreiben
                                .Caption = h.Caption & " ID:=" & h.ID
                                .Style = h.Style
                                .FaceId = h.ID
                            
End With
                        
End If
                    
Next
                
Next
            
Next
    
End If
Next
Application.ScreenUpdating = 
True
Set a = Nothing
Set b = Nothing
Set cb = Nothing
Set c = Nothing
Set b = Nothing
Set cneu = Nothing
Set e = Nothing
Set f = Nothing
Set g = Nothing
Set h = Nothing
Set i = Nothing
End Sub 


Bild

Betrifft: ups,Frage vergessen lol
von: ransi
Geschrieben am: 24.04.2005 16:13:42
hallo
kann mir da jemand einen hilfreichen Denkanstoss geben wie ich dem fehler
beikommen kann.
danke schonmal ins vorraus für hilfe
ransi
Bild

Betrifft: AW: ups,Frage vergessen lol
von: Nepumuk
Geschrieben am: 24.04.2005 19:30:36
Hallo ransi,
deinen Code will ich nicht nachvollziehen. Aber eventuell hilft dir folgendes:
https://www.herber.de/bbs/user/21631.xls
Gruß
Nepumuk
Bild

Betrifft: Treeview hatte ich bis jetzt.
von: ransi
Geschrieben am: 24.04.2005 20:59:33
Hallo Nepumuk
Danke für dein Interesse, aber deinen code habe ich nicht zum laufen bekommen.
"Key is not in unique collection..."
Userbild

Aber mit dem Treeview habe ich es bisher auch gemacht.

Der code zum füllen ist aber ein ganzes Stück länger als deine paar zeilen...
;-)).
Dachte wenn ich das ganze in EINE einzige commandbar packe wirds übersichtlicher.
Einmalig die Commandbar erstellen und fertig.
Ausserdem kann ich da die .FaceID's und .begingroup mit einbinden.
Wenn ich das im Treeview mache hat alleine die Imagelist für die pictures schon 5,8 MB.
Ein weiterer Vorteil wäre das ich das ganze in der VBE-IDE zur verfügung hätte.
Ich stelle die frage mal auf "Frage noch offen".
vieleicht hat noch jemand anderes eine brauchbare Idee was da klemmt.
ransi
Bild

Betrifft: AW: Treeview hatte ich bis jetzt.
von: Hubert
Geschrieben am: 25.04.2005 00:59:28
"Dachte wenn ich das ganze in EINE einzige commandbar packe wirds übersichtlicher."
Ich habe dein Makro nicht ausgeführt, wenn ich das richtig sehe, wird eine Commandbar
erstellt, die alle Commandbars enthält? Für meinen Geschmack verträgt sich das nicht
mit dem zitierten Satz. Das Monster kann nicht übersichtlich sein.
Die CommandBars("Drawing") läßt sich problemlos auslesen.
mfg Hubert
Bild

Betrifft: AW: Treeview hatte ich bis jetzt.
von: Rolf Beißner
Geschrieben am: 25.04.2005 21:14:20
Hallo ransi,
ich denke, dass aufgrund von "on Error.."
irgende Eigenschaft eines vorherigen Settings
beibehalten wird, was du aber exakt nur ermitteln kannst,
wenn du die einzelnen Fehler abfängst.
Ich hab mal versucht, mich mittels Lokalfenster durch zu debuggen,
konnte aber aufgrund der vielen Verschachtelungen den Fehler
nicht genau lokalisieren.
hG
Rolf

Bild

Betrifft: in ...add(Type:=...) ist was faul !
von: ransi
Geschrieben am: 28.04.2005 17:23:06


      
Hallo Rolf, hallo Hubert
Auch euch danke für euer Interesse.
Zur Erkärung für Hubert:
Die commandbar mit den buttons soll als Nachschlagewerk dienen.
Die Buttons sind allesamt ohne Funktion.
An die settings habe ich auch zuerst gedacht, denke aber die sind 
in ordnung.
Da wird kein fauler Kunde mit durchgeschleppt der woanders Probleme macht.
Nach reichlich debuggen und F8 denke ich  es sind die ...add(Type:=...)die schwierigkeiten machen.
Ich glaube da gibt es Typen die will excel nicht setzen.
Hab das 
"vorläufig" erstmal so gelöst, (wenn es euch noch interessiert).
Das Ergebniss kommt meinen Vorstellungen schon ziemlich nah....
Werde aber noch weiter dran basteln.

Option 
Explicit
Public Sub Zeig_Alles()
    
Dim reset As CommandBarControl
    
Dim cb As CommandBar
    
Dim c As CommandBar
    
Dim a As CommandBar 'Zähler
    Dim b As CommandBarControl
    
Dim cneu As CommandBarControl 'neu
    Dim d As CommandBarControl 'Zähler
    Dim e As CommandBarControl 'neu
    Dim f As CommandBarControl 'Zähler
    Dim g As CommandBarControl 'neu
    Dim h As CommandBarControl 'zähler
    Dim i As CommandBarControl 'neu
    Dim j As CommandBarControl
    
Dim k As CommandBarControl
   
On Error Resume Next
DoEvents
Application.ScreenUpdating = 
False
For Each cb In Application.CommandBars
If cb.Name = "Alle Infos" Then cb.Delete
Next
Set c = Application.CommandBars.Add(Name:="Alle Infos")
Set b = c.Controls.Add(msoControlPopup)
Set reset = Application.CommandBars("Alle Infos").Controls.Add(msoControlButton)
b.Caption = 
"ID's "
With reset 'für Neuberechnung
    .Caption = "Reset"
    .Style = msoButtonIconAndCaption
    .FaceId = 940
    .OnAction = 
"Zeig_alles"
End With
c.Visible = 
True
'#############################################################
For Each a In Application.CommandBars
    
If a.Name <> "Alle Infos" Then
        
Set cneu = b.Controls.Add(Type:=msoControlPopup)
        cneu.Caption = a.NameLocal & 
" ID:=" & a.ID & ", Type:= " & a.Type
'##############################################################
        If a.Controls.Count > 0 Then
        
For Each d In a.Controls
            
If Not d Is Nothing Then
                
Set e = cneu.Controls.Add(Type:=IIf(d.Type = 1, 1, 10))
                
With e 'Eigenschaften des Originals abschreiben
                    .Caption = d.Caption & " ID:=" & d.ID & ", Type:= " & d.Type
                    .Style = d.Style
                    .FaceId = d.FaceId
                    .BeginGroup = d.BeginGroup
                
End With
            
End If
'##############################################################
            If d.Controls.Count > 0 Then
            
For Each f In d.Controls
                
If Not f Is Nothing Then
                    
Set g = e.Controls.Add(Type:=IIf(f.Type = 1, 1, 10))
                    
With g 'Eigenschaften des Originals abschreiben
                        .Caption = f.Caption & " ID:=" & f.ID & ", Type:= " & f.Type
                        .Style = f.Style
                        .FaceId = f.FaceId
                        .BeginGroup = f.BeginGroup
                    
End With
                
End If
'###############################################################
                If f.Controls.Count > 0 Then
                
For Each h In f.Controls
                    
If Not h Is Nothing Then
                        
Set i = g.Controls.Add(Type:=IIf(h.Type = 1, 1, 10))
                        
With i 'Eigenschaften des Originals abschreiben
                            .Caption = h.Caption & " ID:=" & h.ID & ", Type:= " & h.Type
                            .Style = h.Style
                            .FaceId = h.FaceId
                            .BeginGroup = h.BeginGroup
                        
End With
                    
End If
'#################################################################
                    For Each j In h.Controls
                    
If Not j Is Nothing Then
                    
Set k = i.Controls.Add(Type:=IIf(j.Type = 1, 1, 10))
                    
With k
                    .Caption = j.Caption & 
" ID:=" & j.ID & ", Type:= " & j.Type
                            .Style = j.Style
                            .FaceId = j.FaceId
                            .BeginGroup = j.BeginGroup
                        
End With
                    
End If
                    
Next
'#################################################################
                Next
             
End If
            
Next
        
End If
        
Next
        
End If
    
End If
Next
Application.ScreenUpdating = 
True
Set a = Nothing
Set reset = Nothing
Set cb = Nothing
Set c = Nothing
Set d = Nothing
Set cneu = Nothing
Set e = Nothing
Set f = Nothing
Set g = Nothing
Set h = Nothing
Set i = Nothing
Set j = Nothing
Set k = Nothing
End Sub 


Bild

Betrifft: AW: in ...add(Type:=...) ist was faul !
von: Rolf Beißner
Geschrieben am: 28.04.2005 18:10:14
Hallo ransi,
das ähnelt stark der Brecheisen-Methode,
die bernd + ich vor geraumer Zeit mal dargestellt hatten.
Falls du was Eleganteres findest, wäre ich dankbarer Abnehmer.
Herzl. Grüße
Rolf
Bild

Betrifft: Der sitzt grade neben mir :-))
von: ransi
Geschrieben am: 28.04.2005 18:42:11
Hallo Rolf
Der bernd sitzt grade neben mir.
Kein wunder das dir das ganze sehr bekannt vorkommt.
Der code damals im Treeview war eine Gemeinschaftsproduktion.
Er hatte die Idee mit dem Treeview und ich den Ehrgeiz das ganze in code zufassen.
ransi
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Formeln per Code / Spalten einfügen und anpassen"