AW: Problem bei ListBox Ansteuerung
04.08.2005 17:18:07
Sören
Hi,
hab dir mal meine codes reingestellt, vielleicht hilfts!?
(Modul1, Tabelle Benchmarks, Tabelle Planungsdaten)
Gruß,
sören
MODUL1:
Option Explicit
Const CBNAME As String = "Menue"
Sub Commandbar_erstellen()
Dim CB As CommandBar 'Menüleiste
Dim cbp As CommandBarPopup 'Menü
Dim cbp1 As CommandBarPopup 'Menü
Dim cbb As CommandBarButton 'Button
'Commandbar löschen
Call Commandbar_loeschen
'Commandbar erststellen
Set CB = CommandBars.Add(CBNAME)
'1.Popup-Menue "Lagerplanung" erstellen
Set cbp = CB.Controls.Add(msoControlPopup)
'Name festlegen 1.Popup-Menue
cbp.Caption = "Lagerplanung"
'1.Untermenue "Planungsbasis ermitteln" ins 1.Popup-Menue "Lagerplanung"
Set cbp1 = cbp.Controls.Add(msoControlPopup)
With cbp1
.Caption = "Planungsbasis ermitteln"
.BeginGroup = True
End With
'1.Button "Planungsdaten" ins 1.Untermenue "Plannungsbasis ermitteln"
Set cbb = cbp1.Controls.Add(msoControlButton)
With cbb
.Style = msoButtonIconAndCaption
.Caption = "Planungsdaten eingeben"
.OnAction = "Planungsdaten_oeffnen"
End With
'2.Button "Benchmarks" ins 1.Untermenue "Planungsbasis ermitteln"
Set cbb = cbp1.Controls.Add(msoControlButton)
With cbb
.Style = msoButtonIconAndCaption
.Caption = "Benchmarks auswählen"
.OnAction = "Benchmarks_oeffnen"
End With
'3.Popup erstellen
Set cbp = CB.Controls.Add(msoControlPopup)
'Name 3.Popup
cbp.Caption = "Startseite"
'5. Button ins 3.Popup
Set cbb = cbp.Controls.Add(msoControlButton)
With cbb
.Style = msoButtonIconAndCaption
.Caption = "Startseite"
.BeginGroup = True
.FaceId = 1
.OnAction = "Startseite_oeffnen"
End With
'Commandbar anzeigen
With CB
.Enabled = True
.Visible = True
.Position = msoBarTop
End With
End Sub
Sub Planungsdaten_oeffnen()
Worksheets("Planungsdaten").Activate
End Sub
Sub Benchmarks_oeffnen()
Worksheets("Benchmarks").Activate
End Sub
Sub Startseite_oeffnen()
Worksheets("startseite").Activate
End Sub
Sub Commandbar_loeschen()
On Error Resume Next
CommandBars(CBNAME).Delete
End Sub
DIESE ARBEITSMAPPE:
Option Explicit
Private Sub Workbook_Open()
Dim intLeSp1, intSp1 As Integer 'Letzte Spalte, Spalte(Tabelle: Benchmarks)
intLeSp1 = Worksheets("Benchmarks").Range("IV2").End(xlToLeft).Column
'Letzte Spalte ermitteln
For intSp1 = 9 To intLeSp1
With Worksheets("Planungsdaten").ListBox_Lager
.AddItem Worksheets("Benchmarks").Cells(2, intSp1)
'Eintrag in Listbox einfügen
End With
Next intSp1
'Nächster Eintrag
End Sub
TABELLE BENCHMARKS:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intlecolumn As Integer 'Letzte Spalte
Dim intcolumn As Integer 'Spalte
If Target.Row = 2 Then 'Zielzeile 2
intlecolumn = Worksheets("Benchmarks").Range("IV2").End(xlToLeft).Column
'Letzte Spalte ermitteln
Worksheets("Planungsdaten").ListBox_Lager.Clear
'Einträge löschen
For intcolumn = 9 To intlecolumn
With Worksheets("Planungsdaten").ListBox_Lager
.AddItem Worksheets("Benchmarks").Cells(2, intcolumn)
'Eintrag in Listbox einfügen einfügen
End With
Next intcolumn
'Nächster Eintrag
End If
End Sub
TABELLE PLANUNGSDATEN:
Option Explicit
Private Sub ListBox_Lager_Change()
Dim intindex As Integer '1.Zähler ListBox_Lager
Dim intZe As Integer 'Zeile
Dim Formel As String 'Formel Mittewert
Dim i As Integer '2.Zähler Listbox_Lager
Dim t1 As String
Dim t2 As String
Dim x As Integer
Range("E75:E155").Value = ""
'Einträge löschen
intZe = 75
'Startzeile
For intindex = 0 To ListBox_Lager.ListCount - 1
'Obergrenze der Schleife festlegen
If ListBox_Lager.Selected(intindex) = True Then
'Prüfen, ob ein Eintrag ausgewählt ist
Cells(intZe, 5).Value = ListBox_Lager.List(intindex)
'Übertragen der ausgewählten Einträge
intZe = intZe + 1
'in die nächste zeile schreiben
End If
Next intindex
Formel = "=wenn(h:h=0;" & Chr(34) & Chr(34) & ";("
'Formel: = wenn spalte h = 0; dann "" ;sonst Mittelwert aus den
'in der ListBox_Lager selektierten Daten
'Mittelwert wird aus (n1+n2+n3+...nx)/x) berechnet.
'Anfang der Formel: =wenn(h:h=0;"";(...
For i = 0 To ListBox_Lager.ListCount - 1
'Alle LIstBox-Einträge prüfen, ob sie markiert sind.
If ListBox_Lager.Selected(i) Then
'wenn markiert, dann...
t1 = "=ADDRESS(9," & i + 9 & ",4,,""Benchmarks"")"
'relative Adresse der Spalte in Tabelle "Benchmarks" ermitteln
'siehe Excel-Funktion "Adresse"
Formel = Formel & Evaluate(t1) & "+"
'Durch Evaluate wird der Ausdruck in t berechnet
'an die Adresse des ListBox-Eintrags wird ein "+" drangehängt
x = x + 1
'Anzahl der Elemente berechnen
End If
Next i
Formel = Left(Formel, Len(Formel) - 1) & ")/" & x & ")"
'letztes "+" im Formel-String löschen und Formel abschließen
'durch hinzufügen von ...)/x
'gesamter Formel-String lautet somit: =Wenn(h:h=0;"";(n1+n2+n3+...+nx)/x)
If Len(Formel) > 1024 Then MsgBox "Formel zu lang": Exit Sub
'MsgBox, wenn Formel-String zu lang
If x > 0 Then
Range("j9:j72").FormulaLocal = Formel
'Formel-String in Tabelle "Planungsdaten" reinschreiben
Else
Range("j9:j72").FormulaLocal = ""
End If
End Sub