Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
788to792
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Problem

VBA Problem
14.08.2006 15:18:01
Peter
Hallo,
ich arbeite an einem Tool zur grafischen Datenauswertung.
Mit Hilfe von VBA soll das Tool in der Lage sein bis zu 3000 Daten zu verarbeiten.
Die aktuelle Datei mit 2024 Datensätzen ist leider zu groß zum Hochladen. Eine ältere ähnliche Version mit nur 12 Datensätzen, bei der die Codes fast die selben sind lade ich mal hoch.
https://www.herber.de/bbs/user/35781.xls
Problem 1:
Das funktioniert auch, leider dauert eine Auswertung (bei z.B. 2024 Datensätzen) bis zu 10 Minuten oder bleibt manchmal sogar hängen.
Wie kann ich das Beschleunigen?
Leider kann ich die betreffende Datei nicht hochladen (5MB).
Email Adressen zu direkt mailen wären nötig.
Problem 2:
Die Anzahl der Darzustellenden Werte soll gleich der Zahl in Zelle "$I$3" im Tabellenblatt "Hilfe" sein.
betreffende Stelle im Code:
gesetzte Anzahl funktioniert:
Private Sub Chart_Activate()
Dim index As Integer
AnzahlWerte = 2024 'Anzahl der dargestellten Punkte
mein Code:
Private Sub Chart_Activate()
Dim index As Integer
AnzahlWerte = Worksheets("Datenübernahme").Range("$I$3") 'Anzahl der dargestellten Punkte
funktioniert nicht!
Wie ist es richtig?
Problem 3:
Die Bezügen für den Datenbereich im x,y Diagramm sollen nicht gesetzt sein, sondern je nach Anzahl der Datenmenge flexibel.
Im Moment stehen die X-Werte in den Zellen B4 bis B53 im Tabellenblatt "Hilfe" und die Y-Werte in den Zellen C4 bis C53.
Daten können aber auch (je nach Quelldatei) bis in Zeile 2027 oder noch mehr stehen.
Wenn ich dem vorbeugen will und den Bezug bis auf Zeile 2027 setze erfasst das Diagramm auch die leer stehenden Zellen.
Wie bekomme ich es hin, dass das Diagramm lehre Zellen nicht mit erfasst oder gibt es noch eine andere Lösung?
mfg Peter

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Problem
14.08.2006 16:13:38
Sylvio
Hallo Peter,
ohne die Datei angeschaut zu haben ist hier schon was auffällig:
Private Sub Chart_Activate()
Dim index As Integer
AnzahlWerte = Worksheets("Datenübernahme").Range("$I$3") 'Anzahl der dargestellten Punkte
Schreib es so: AnzahlWerte = Thisworkbook.Sheets("Datenübernahme").Cells(3,9).Value
Überprüf bitte auch die richtige Deklaration deiner Werte, da du mehrere Mappe händelst. Nicht das was verloren geht.
Gruß Sylvio
AW: VBA Problem
14.08.2006 16:41:40
Peter
Hallo,
danke Sylvio, Problem 2 ist gelöst.
Was du allerdings damit ("Überprüf bitte auch die richtige Deklaration deiner Werte, da du mehrere Mappe händelst. Nicht das was verloren geht.") meinst ist mir nicht klar.
Eine nähere Erklährung wäre gut.
Grüße aus Berlin
Peter
Anzeige
AW: VBA Problem
14.08.2006 16:39:20
EtoPHG
Hallo Peter,
Problem 1:
Unter der Annahme das Deine Chart_Activate() etwa 10 Minuten dauert:
Am Anfang der Routine:

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Nach deinem Code:

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

Problem 2:
Formel in Tabelle "Hilfe" Zelle I3

=65535-ANZAHLLEEREZELLEN('Datenquelle Bäume'!A:A)

dann sollte

AnzahlWerte = Sheets("Hilfe").Range("$I$3").Value

funktionieren.
Problem 3:
Suche mal in der Recherche "Diagramm mit variablem Bereich".
Gruss Hansueli
Anzeige
AW: VBA Problem
14.08.2006 17:07:23
Peter
Hallo,
danke Hansueli, Problem 1 kann ich leider noch nicht lösen.
An welcher genauen Stelle muß ich deinen Code:
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
einfügen?
Grüße aus Berlin
Peter
AW: VBA Problem
14.08.2006 17:12:58
EtoPHG
Hallo Peter

Private Sub Chart_Activate()
Dim index As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'... Dein Code
'... Ende Deines Codes
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Gruss Hansueli
Anzeige
AW: VBA Problem
14.08.2006 18:03:16
Peter
Hallo Hansueli,
ich hab deinen Code wie folgt eingefügt:
Dim altx As Integer
Dim alty As Integer
Dim AnzahlWerte As Integer

Private Sub Chart_Activate()
Dim index As Integer
With Application 'beschleunigt Berechnung
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
AnzahlWerte = Sheets("Hilfe").Range("$I$3").Value 'übernimmt Anzahl der Datensätze aus Zelle I3 vom Tabellenblatt "Hilfe"
'Löschen der vorherigen Anzeige beim wechsel von Tabellenblatt zum Diagrammblatt
'soll die vorherige Beschriftung beibehalten werden, dann das hier auskommentieren
'ggf dafür sorgen, dass gar kein Text mehr drin steht....
If altx <> 0 And alty <> 0 Then
Charts("Koordinaten Darstellung").SeriesCollection(altx).Points(alty).HasDataLabel = False
End If
'Alle Punkte sollen anhand der Daten unterschiedliche Farben bekommen
' alle Punkte bekommen ein Punkt als Form und die Größe 12
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
.MarkerStyle = xlMarkerStyleCircle
.MarkerSize = 8
End With
Next index
' Auswahl im DropDown an aktueller Darstellung orientieren
' ggf eine andere Darstellung als Start wählen
Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value = 1
Application.Run ("Kombinationsfeld")
' Focus auf das Diagramm legen, damit die lila Punkte verschwinden (bei Auswahl)
ActiveChart.PlotArea.Select
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Private Sub Chart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement x, y, ElementID, Arg1, Arg2
'If ElementID = xlShape Then
'MsgBox ("Elemetid: " & ElementID & "...Arg1:" & Arg1 & "...Arg2:" & agr2)
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value)
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").Type)
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").FormControlType)
'If Charts("Koordinaten Darstellung").Shapes("Drop Down 5").FormControlType = xlDropDown Then
'If Charts("Koordinaten Darstellung").Shapes("Drop Down 5").Type = msoFormControl Then
'MsgBox ("Drop down")
'End If
'End If
' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.index _
(.SeriesCollection(Arg1).Values, Arg2)
' Display message box with point information
'  MsgBox "Series " & Arg1 & vbCrLf _
'    & """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
'    & "Point " & Arg2 & vbCrLf _
'    & "X = " & myX & vbCrLf _
'    & "Y = " & myY
' Informationen des letzten angeklickten Punktes nicht mehr anzeigen
If altx <> 0 And alty <> 0 Then
With Charts("Koordinaten Darstellung").SeriesCollection(altx).Points(alty)
.HasDataLabel = False
End With
End If
' Informationen des aktuell angeklickten Punktes anzeigen
With Charts("Koordinaten Darstellung").SeriesCollection(Arg1).Points(Arg2)
.HasDataLabel = True
'die Beschriftung des Datensatzes als Text ausgeben
'.ApplyDataLabels Type:=xlDataLabelsShowLabel
' Text des Labels frei definieren:
' Text aus der Spalte J (in entsprechender Zeile) holen
.DataLabel.Text = Worksheets("Hilfe").Range("A" & Arg2 + 3)
' Schriftgrösse fest auf 8 einstellen
.DataLabel.Font.Size = 8
' Farbe des Textes setzen (1=schwarz)
.DataLabel.Font.ColorIndex = 1
End With
' aktuelle Werte für den nächsten klick merken
altx = Arg1
alty = Arg2
' Select auf das gesamte Diagramm setzen, damit die Punkte nicht Lila sind
ActiveChart.PlotArea.Select
End If
End If
End With
End Sub

Leider gibt es bei der Auswahl der Merkmale mit Hilfe des Kombinationsfeldes und der anschließenden Überprüfung der einzelnen Punkte keine Veränderung in der Verarbeitungsgeschwindigkeit.
Verändert hat sich nur die Art und Weise des "Bildschirmflackerns" beim Wechsel zum z.B. Tabellenblatt "Hilfe" zum Diagramm. Jetzt "flackert" es nicht mehr, sondern ca. 1 Minute erscheint die Sanduhr des Coursers und alle Punkte sind aktualisiert.
Muß ich in Modul1 auch noch was verändern?
aktuelles Modul1:
Dim AnzahlWerte As Integer
Sub Kombinationsfeld()
' Anhand der Auswahl im DropDown-Feld werden unterschiedliche Legenden angezeigt
AnzahlWerte = Sheets("Hilfe").Range("$I$3").Value
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value)
'MsgBox (Charts("Koordinaten Darstellung").SeriesCollection(1).Points.Count)
'zuerst alle Textboxen unsichtbar, um anschliessend die eine sichtbar zu machen
Charts("Koordinaten Darstellung").Shapes("Text Box 4").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 7").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 8").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 9").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 10").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 11").Visible = False
Select Case Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value
Case 1
Charts("Koordinaten Darstellung").Shapes("Text Box 8").Visible = True
Application.Run ("Modul1.Auswahl1")
Case 2
Charts("Koordinaten Darstellung").Shapes("Text Box 9").Visible = True
Application.Run ("Modul1.Auswahl2")
Case 3
Charts("Koordinaten Darstellung").Shapes("Text Box 7").Visible = True
Application.Run ("Modul1.Auswahl3")
Case 4
Charts("Koordinaten Darstellung").Shapes("Text Box 4").Visible = True
Application.Run ("Modul1.Auswahl4")
Case 5
Charts("Koordinaten Darstellung").Shapes("Text Box 10").Visible = True
Application.Run ("Modul1.Auswahl5")
Case 6
Charts("Koordinaten Darstellung").Shapes("Text Box 11").Visible = True
Application.Run ("Modul1.Auswahl6")
Case 7
Application.Run ("Modul1.Auswahl7")
Case 8
Application.Run ("Modul1.Auswahl8")
Case 9
Application.Run ("Modul1.Auswahl9")
Case 10
Application.Run ("Modul1.Auswahl10")
Case 11
Application.Run ("Modul1.Auswahl11")
End Select
End Sub
Sub Auswahl1()
' Auswahl in der DropDown ist "Baum-Art"
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte B
Select Case Worksheets("Datenübernahme").Range("B" & index + 3)
Case "Eiche/Roteiche"
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
End Select
End With
Next index
End Sub
Sub Auswahl2()
' Auswahl in der DropDown ist "Bearbeiter"
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte D
Select Case Worksheets("Datenübernahme").Range("D" & index + 3)
Case "1 = Nobis"
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case "2 = Kalmukow"
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
End Select
End With
Next index
End Sub
Public Sub Auswahl3()
' Auswahl in der DropDown ist "Stamm-Durchmesser in 1,3 m Höhe"
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte E
Select Case Worksheets("Datenübernahme").Range("E" & index + 3)
Case 0 To 0.1
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 0.11 To 0.2
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 0.21 To 0.3
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 0.31 To 0.4
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 0.41 To 0.5
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 0.51 To 0.6
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
End Sub
Sub Auswahl4()
' Auswahl in der DropDown ist "Stammhöhe astfrei"
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte F
Select Case Worksheets("Datenübernahme").Range("F" & index + 3)
Case 0 To 2
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 2.01 To 4
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 4.01 To 6
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 6.01 To 8
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 8.01 To 10
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 10.01 To 12
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
End Sub
Sub Auswahl5()
' Auswahl in der DropDown ist "Baum-Höhe in m "
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte G
Select Case Worksheets("Datenübernahme").Range("G" & index + 3)
Case 0 To 5
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 5.01 To 10
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 10.01 To 15
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 15.01 To 20
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 20.01 To 25
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 25.01 To 30
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
End Sub
Sub Auswahl6()
' Auswahl in der DropDown ist "Krohnen-Durchmesser in m"
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte H
Select Case Worksheets("Datenübernahme").Range("H" & index + 3)
Case 0 To 3
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 3.01 To 6
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 6.01 To 9
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 9.01 To 12
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 12.01 To 15
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 15.01 To 18
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
End Sub
Sub Auswahl7()
End Sub
Sub Auswahl8()
End Sub
Sub Auswahl9()
End Sub
Sub Auswahl10()
End Sub
Sub Auswahl11()
End Sub
Grüße aus Berlin
Peter
Anzeige
AW: VBA Problem
15.08.2006 08:52:55
EtoPHG
Hallo Peter,
Um die Verschnellerung des Codes einfacher zu machen:
1. Füge in das Modul1 eine neue Routine ein:

Sub SpeedUp(bOn As Boolean)
If bOn Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Else
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub

In jeder Sub, welche das Diagramm oder Daten verändern, fügst du z.B. ein

Sub X()
SpeedUp(True)
'    hier Dein bestehender Code
SpeedUp(False)
End Sub

Gruss Hansueli
Anzeige
AW: VBA Problem 3 Nachtrag
14.08.2006 18:38:39
Peter
Hallo,
ist nicht das was ich brauche.
Bei diesem Beispiel zeigt das Diagramm leere Stellen nicht an, behält jedoch den Wertebereich bei.
Ergebnis beim Wechsel von großen Datensätzen auf kleine: der Maßstab des Diagramms liegt noch beim großen Datensatz (ist halt auf einen bestimmten Zellbereich vordefiniert) und es ist nur ein kleiner Punkthaufen auf dem Diagramm zu sehen, der Rest ist leer.
Ich suche auch schon eine ganze Weile im Netz und hab das hier gefunden:

Sub Makro2()
' Datenbereich markieren
Range("D1:D10").Select
' Bearbeiten - Gehe zu - Inhalte auswählen - Leere Zellen
Selection.SpecialCells(xlCellTypeBlanks).Select
' Format - Zelle ausblenden
Selection.EntireRow.Hidden = True
End 

Sub
Leider weiss ich nicht wo und wie ich diesen Code bei mir einfügen muß.
Grüße aus Berlin
Peter

Anzeige
AW: VBA Problem 3 Nachtrag
14.08.2006 19:01:13
Daniel
Hallo
am besten am Ende von Sub Chart_activate irgendwo einbauen:
sheets("Hilfe").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Gruß, Daniel
AW: VBA Problem
14.08.2006 18:32:56
Daniel
Hallo
Lösung zu 3:
schau mal hier rein, vielleicht hilft das weiter.
https://www.herber.de/forum/messages/791469.html
allderding solltest du deine Tabellen etwas bereinigen, die Datentabellen sollen nur aus Überschrift (in Zeile 1) und Daten (ab Zeile 2) bestehen.
Die Leerzeilen 1 und 2 in einigen deiner Tabellen sind für eine einfache Bearbeitung mit Makros eher hinderlich.
Lösung zu 2
Da muß man jetzt ins Detail rein.
Bspw. nach überflüssigen Schleifen suchen.
Folgende Schleife ist nicht erforderlich und kann einfacher umgesetzt werden:

Private Sub Chart_Activate()
'Alle Punkte sollen anhand der Daten unterschiedliche Farben bekommen
' alle Punkte bekommen ein Quadrat als Form und die Größe 12
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
.MarkerStyle = xlMarkerStyleSquare
.MarkerSize = 12
End With
Next index
End Sub

ist unnötig und kann hierdurch ersetzt werden:
Charts("Koordinaten Darstellung").SeriesCollection(1).MarkerStyle = xlMarkerStyleSquare
Charts("Koordinaten Darstellung").SeriesCollection(1).MarkerSize = 12
(bekommen alle Punkte eines Diagramms die gleiche Formatierung, ist es nicht erforderlich, jeden einzelpunkt zu formatieren, man kann auch der ganzen Serie das Format auf einmal zuweisen.)
die zweite Bremse sind die Schleifen in den Sub Auswahlxx - Makros.
Hier läßt sich die Schleife zuwar nicht vermeiden, allerdings ist die eigentliche Bremse der Zugriff auf Tabellenwerte mit Sheets().range().value
Hier hilft es, die Tabellenwerte vor dem Schleifendruchlauf in eine Array-Variable einzulesen, um dann in der Schleife den Wert aus der Variable zu hohlen.
Das ist wesentlich schneller als der Rückgriff auf die Tabelle.
so mußt du die Auswahl-Makros umschreiben, um die Geschwindigkeit zu erhöhen:

Private Sub Auswahl()
' Auswahl in der DropDown ist "Baum-Art"
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahem").Range("B3:B" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte B
Select Case arrWerte(index, 1) 'hier wird die Array-Variable verwendet
Case "Eiche/Roteiche"
End Sub

das solltest du angepasst in alle Auswahl-Subs einbauen.
Dann müsste sich die Geschwindigkeit spürbar erhöhen.
ansonsten könnte noch helfen, da deine Tabellen viele berechnet Zellen enthalten,
die automatische Neuberechnung und die Bildschirmanzeige beim Makro-Ablauf auszuschalten.
hierzu am Anfang und ende von Sub Chart_Activate folgendes eingeben:

Private Sub Chart_Activate()
application.ScreenUpdating = false
application.Calculation = xlCalculationManual
application.ScreenUpdating = true
application.Calculation = xlCalculationAutomatic
End Sub

sollte das Programm allerdings mit einem Fehler abbrechen, mußt du die automatische neuberechnung der Zellen von Hand wieder aktivieren.
Dies geht in EXTRAS - OPTIONEN - BERECHNUNG
Wenn das alles noch nicht ausreicht, solltes du dir überlegen, ob du deine Tabellen nicht einfacher aufbauen kannst, da sie viele aufwendige Text-Formeln enthalten, die Performance und Speicher kosten.
Gruß, Daniel
(p.s. Coole Anwendung, mal was anderes, als das ganze Controller-Zeugs ;-))
Anzeige
AW: VBA Problem
15.08.2006 15:10:01
Peter
Hallo,
1.
nachdem ich meine Tabellen bereinigt hatte (1. Zeile Überschrift ab 2. Zeile Daten),habe ich es nicht fehlerfrei geschaft die Bezüge in den Codes anzupassen.
Bitte zeige mir an welchen Stellen und wie ich was ändern muß.
(aktueller Code unten)
Bitte Hilfe!
2.
leider haben die Codes mit den Array-Variablen zu keine merklichen Erhöhung der Geschwindigkeit geführt. Ich habe sie trotzdem eingebaut.
Dadurch ist vielmehr ein neues Problem aufgetaucht:
Jetzt wird das 1. Merkmal das in der 4. Zeile in allen Tabellenblättern steht nicht mehr nach seiner Ausprägung (Farbe im Diagramm) untersucht. Vermutlich stimmt eine Zeilenzuordnung nicht, ich hab den Fehler nicht gefunden.
Bitte Hilfe!
3.
die Codes für die automatischen Neuberechnung und die Bildschirmanzeige habe ich im Sub Chart Activate und im Module1 mit Sub SpeedUp eingebaut.
Das bringt jetzt schon mal viel Geschwindigkeit.
Ist OK!
4.
Der Code mit dem Zellen ausblenden hat nichts gebracht!
'Nullstellen im Diagramm nicht anzeigen
Sheets("Hilfe").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Ich hab mich nochmal mit dem Beispiel befasst, allerdings akzeptiert Excel nicht meinen Dateinamen und die Definition der Namen und Werte ist mir auch unverständlich.
Wäre nett, wenn für meine Anwendung eine Anpassung erfolgen könnte!
Bitte Hilfe!
""VBA ist dafür nicht notwendig, nichtsdestotrotz muß man einwenig in die Trickkiste greifen.
1. die Werte- und Namenszuordung in der Grafik darf nicht direkt, sondern muß über einen Namen erfolgen
diese Zuordnung funktioniert aber in den Grafiken nur, wenn der Datei-Name vorangestellt wird (in Hochkommas und mit ! vom Namen getrennt)
Beispiel: ='Dynamische Grafik.xls'!Werte
2. die Namen müßen dynamisch sein, dh. die Definiton erfolgt nicht absolut, sondern über Formeln, die den Zellbereich automatisch anpassen:
Beispiel: Definition für "Werte" =BEREICH.VERSCHIEBEN(Tabelle1!$B$1;1;;ANZAHL2(Tabelle1!$B:$B)-1;)
Dann paßt sich auch die Grafik automatisch an. vorausetzung ist allerdings, daß die Tabelle keine Leerzeilen enthält.
Siehe Beispiel https://www.herber.de/bbs/user/35776.xls ""
nachfolgend meine aktuellen Codes:
1.Diagramm:
Dim altx As Integer
Dim alty As Integer
Dim AnzahlWerte As Integer

Private Sub Chart_Activate()
Dim index As Integer
With Application 'beschleunigt Berechnung
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
AnzahlWerte = Sheets("Hilfe").Range("$I$3").Value 'übernimmt Anzahl der Datensätze aus Zelle I3 vom Tabellenblatt "Hilfe"
'Löschen der vorherigen Anzeige beim wechsel von Tabellenblatt zum Diagrammblatt
'soll die vorherige Beschriftung beibehalten werden, dann das hier auskommentieren
'ggf dafür sorgen, dass gar kein Text mehr drin steht....
If altx <> 0 And alty <> 0 Then
Charts("Koordinaten Darstellung").SeriesCollection(altx).Points(alty).HasDataLabel = False
End If
'Alle Punkte sollen anhand der Daten unterschiedliche Farben bekommen
' alle Punkte bekommen ein Punkt als Form und die Größe 12
Charts("Koordinaten Darstellung").SeriesCollection(1).MarkerStyle = xlMarkerStyleCircle
Charts("Koordinaten Darstellung").SeriesCollection(1).MarkerSize = 8
' Auswahl im DropDown an aktueller Darstellung orientieren
' ggf eine andere Darstellung als Start wählen
Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value = 1
Application.Run ("Kombinationsfeld")
' Focus auf das Diagramm legen, damit die lila Punkte verschwinden (bei Auswahl)
ActiveChart.PlotArea.Select
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Private Sub Chart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement X, y, ElementID, Arg1, Arg2
'If ElementID = xlShape Then
'MsgBox ("Elemetid: " & ElementID & "...Arg1:" & Arg1 & "...Arg2:" & agr2)
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value)
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").Type)
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").FormControlType)
'If Charts("Koordinaten Darstellung").Shapes("Drop Down 5").FormControlType = xlDropDown Then
'If Charts("Koordinaten Darstellung").Shapes("Drop Down 5").Type = msoFormControl Then
'MsgBox ("Drop down")
'End If
'End If
' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.index _
(.SeriesCollection(Arg1).Values, Arg2)
' Display message box with point information
'  MsgBox "Series " & Arg1 & vbCrLf _
'    & """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
'    & "Point " & Arg2 & vbCrLf _
'    & "X = " & myX & vbCrLf _
'    & "Y = " & myY
' Informationen des letzten angeklickten Punktes nicht mehr anzeigen
If altx <> 0 And alty <> 0 Then
With Charts("Koordinaten Darstellung").SeriesCollection(altx).Points(alty)
.HasDataLabel = False
End With
End If
' Informationen des aktuell angeklickten Punktes anzeigen
With Charts("Koordinaten Darstellung").SeriesCollection(Arg1).Points(Arg2)
.HasDataLabel = True
'die Beschriftung des Datensatzes als Text ausgeben
'.ApplyDataLabels Type:=xlDataLabelsShowLabel
' Text des Labels frei definieren:
' Text aus der Spalte J (in entsprechender Zeile) holen
.DataLabel.Text = Worksheets("Hilfe").Range("A" & Arg2 + 3)
' Schriftgrösse fest auf 8 einstellen
.DataLabel.Font.Size = 8
' Farbe des Textes setzen (1=schwarz)
.DataLabel.Font.ColorIndex = 1
End With
' aktuelle Werte für den nächsten klick merken
altx = Arg1
alty = Arg2
' Select auf das gesamte Diagramm setzen, damit die Punkte nicht Lila sind
ActiveChart.PlotArea.Select
End If
End If
End With
End Sub

2. Modul1:
Dim AnzahlWerte As Integer
Sub SpeedUp(bOn As Boolean)
If bOn Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Else
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
Sub Kombinationsfeld()
SpeedUp (True)
' Anhand der Auswahl im DropDown-Feld werden unterschiedliche Legenden angezeigt
AnzahlWerte = Sheets("Hilfe").Range("$I$3").Value
'MsgBox (Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value)
'MsgBox (Charts("Koordinaten Darstellung").SeriesCollection(1).Points.Count)
'zuerst alle Textboxen unsichtbar, um anschliessend die eine sichtbar zu machen
Charts("Koordinaten Darstellung").Shapes("Text Box 4").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 7").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 8").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 9").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 10").Visible = False
Charts("Koordinaten Darstellung").Shapes("Text Box 11").Visible = False
Select Case Charts("Koordinaten Darstellung").Shapes("Drop Down 5").ControlFormat.Value
Case 1
Charts("Koordinaten Darstellung").Shapes("Text Box 8").Visible = True
Application.Run ("Modul1.Auswahl1")
Case 2
Charts("Koordinaten Darstellung").Shapes("Text Box 9").Visible = True
Application.Run ("Modul1.Auswahl2")
Case 3
Charts("Koordinaten Darstellung").Shapes("Text Box 7").Visible = True
Application.Run ("Modul1.Auswahl3")
Case 4
Charts("Koordinaten Darstellung").Shapes("Text Box 4").Visible = True
Application.Run ("Modul1.Auswahl4")
Case 5
Charts("Koordinaten Darstellung").Shapes("Text Box 10").Visible = True
Application.Run ("Modul1.Auswahl5")
Case 6
Charts("Koordinaten Darstellung").Shapes("Text Box 11").Visible = True
Application.Run ("Modul1.Auswahl6")
Case 7
Application.Run ("Modul1.Auswahl7")
Case 8
Application.Run ("Modul1.Auswahl8")
Case 9
Application.Run ("Modul1.Auswahl9")
Case 10
Application.Run ("Modul1.Auswahl10")
Case 11
Application.Run ("Modul1.Auswahl11")
End Select
SpeedUp (False)
End Sub

Private Sub Auswahl1()
SpeedUp (True)
' Auswahl in der DropDown ist "Baum-Art"
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("B3:B" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte B
Select Case arrWerte(index, 1) 'hier wird die Array.Variable verwendet
Case "Eiche/Roteiche"
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
End Select
End With
Next index
SpeedUp (False)
End Sub

Sub Auswahl2()
SpeedUp (True)
' Auswahl in der DropDown ist "Bearbeiter"
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("D3:D" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte D
Select Case arrWerte(index, 1) 'hier wird die Array.Variable verwendet
Case "1 = Nobis"
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case "2 = Kalmukow"
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
End Select
End With
Next index
SpeedUp (False)
End Sub
Public Sub Auswahl3()
SpeedUp (True)
' Auswahl in der DropDown ist "Stamm-Durchmesser in 1,3 m Höhe"
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("E3:E" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte E
Select Case arrWerte(index, 1) 'hier wird die Array.Variable verwendet
Case 0 To 0.1
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 0.11 To 0.2
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 0.21 To 0.3
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 0.31 To 0.4
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 0.41 To 0.5
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 0.51 To 0.6
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
SpeedUp (False)
End Sub
Sub Auswahl4()
SpeedUp (True)
' Auswahl in der DropDown ist "Stammhöhe astfrei"
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("F3:F" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte F
Select Case arrWerte(index, 1) 'hier wird die Array.Variable verwendet
Case 0 To 2
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 2.01 To 4
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 4.01 To 6
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 6.01 To 8
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 8.01 To 10
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 10.01 To 12
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
SpeedUp (False)
End Sub
Sub Auswahl5()
SpeedUp (True)
' Auswahl in der DropDown ist "Baum-Höhe in m "
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("G3:G" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte G
Select Case arrWerte(index, 1) 'hier wird die Array.Variable verwendet
Case 0 To 5
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 5.01 To 10
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 10.01 To 15
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 15.01 To 20
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 20.01 To 25
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 25.01 To 30
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
SpeedUp (False)
End Sub
Sub Auswahl6()
SpeedUp (True)
' Auswahl in der DropDown ist "Krohnen-Durchmesser in m"
Dim Werte
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("H3:H" & AnzahlWerte + 2).Value
For index = 1 To AnzahlWerte
With Charts("Koordinaten Darstellung").SeriesCollection(1).Points(index)
'Farbe anhand des Eintrages in Spalte H
Select Case arrWerte(index, 1) 'hier wird die Array.Variable verwendet
Case 0 To 3
.MarkerForegroundColorIndex = 6
.MarkerBackgroundColorIndex = 6
Case 3.01 To 6
.MarkerForegroundColorIndex = 4
.MarkerBackgroundColorIndex = 4
Case 6.01 To 9
.MarkerForegroundColorIndex = 10
.MarkerBackgroundColorIndex = 10
Case 9.01 To 12
.MarkerForegroundColorIndex = 8
.MarkerBackgroundColorIndex = 8
Case 12.01 To 15
.MarkerForegroundColorIndex = 5
.MarkerBackgroundColorIndex = 5
Case 15.01 To 18
.MarkerForegroundColorIndex = 3
.MarkerBackgroundColorIndex = 3
End Select
End With
Next index
SpeedUp (False)
End Sub
Sub Auswahl7()
End Sub
Sub Auswahl8()
End Sub
Sub Auswahl9()
End Sub
Sub Auswahl10()
End Sub
Sub Auswahl11()
End Sub
Grüße aus Berlin
Peter
Anzeige
AW: VBA Problem
15.08.2006 20:57:31
Daniel
Hallo
zu 1 und 2
ehrlich gesagt, habe ich jetzt keine Lust, deinen ganzen Code auf Zellbezüge zu durchsuchen (ist ohne Datei auch kaum zuverlässig möglich).
Wenn in der alten Version funktioniert hat, dann laß den alten Code so wie er ist und stell die Tabellen wieder so her, wie sie waren.
Bei den Zuweisungen der Array-Variablen mußt du darauf achten, daß im Zellbezug auch genau auf den Dateninhalt ohne Überschrift zeigt, dann sollte es funktionieren und Problem 2 sollte auch behoben sein.
allerdings solltest du prüfen, ob die Formeln in den Tabellen noch stimmen.
zu 3)
schön, das es geht.
allerdings kannst du die Speed-Up aus den ganzen Auswahl_Makros herausnehmen.
Die Auswahl_Makros werden ja vom Kombinationsfeld_Makro aus aufgerufen, die Einstellungen beiben dabei aktiv, von daher reicht es, das Speed_Up im Kombinationsfeld_makro einzubauen
zu 4)
schau mal, ob bei dir bei EXTRAS - OPTIONEN - DIAGRAMM
das Häkchen bei Nur "sichtbare Zellen" gesetzt ist.
und ob die Addressierung richtig gesetzt ist, so daß auch die erforderlichen Zellen ausgeblendet werden.
was den Namensbezug angeht, das ist etwas komplizierter, da solltest du erstmal mit einfacheren Beispielen Erfahrung sammeln.
Gruß, Daniel
Anzeige
AW: VBA Problem
16.08.2006 13:58:38
Peter
Hallo,
ein klein wenig Hilfe brauch ich dann doch noch.
zu 2.
am Beispiel: ich habe im Tabellenblatt "Datenübernahme" in Zelle B3 die Überschrift und ab B4 fangen die Daten an. Folgender Code läßt den 1. Punkt aus. Wenn ich B4 schreibe meckert VBA. Was ist da falsch?
'Array-Variable zuweisen
arrWerte = Sheets("Datenübernahme").Range("B3:B" & AnzahlWerte + 2).Value
zu 4.
das Häckchen ist bei mir gesetzt.
Ich habe festgestellt, das bei dem Code
sheets("Hilfe").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
nicht die erforderlichen Zellen ausgeblendet werden. Das sind genau diese in denen eine Formel steht die sagt, wenn im Tabellenblatt Datenquelle Zelle sowiso nichts ist schreibe bitte "" in die Zelle. Die Koordinaten stehen bei mir in Spalten B und C. In Spalte A steht eine Formel (Text der für den jeweiligen Punkt angezeigt wird) die sich im Ergebnis genauso verhält wie in B und C (also "").
Gibt es da einen anderen Befehl den man nehmen könnte oder eine anderen Lösungsweg.
Die Sache ist für mich sehr wichtig!
neues Anliegen:
Ich suche nach einer Möglichkeit die ganze Fläche vom Koordinatensystem (die ganze "Zeichnungsfläche"), d.h. vom Schnittpunkt der x,y Achsen bis in alle anderen Ecke für meinen Punkte nutzen zu können. Nochmal genauer: der Punkt der sich am weitesten links unten befindet (kleinster x und y Wert)soll sich im Prinzip im oder nahe am Schnittpunkt der Achsen befinden. Genauso sollen die Punkte die am weitesten in den 3 anderen Ecken liegen sich an den äußersten Ecken der Zeichnungsfläche befinden.
Mir war so, als ob man das in Excel einstellen kann, ich finde es aber nicht.
Wo bzw. wie kann man das einstellen?
Danke im Voraus
Grüße aus Berlin
AW: VBA Problem
16.08.2006 23:24:05
Daniel
Hallo
zu 2
der Zellbereich muß genau auf die Daten zeigen, vor allem wenn die Array-Variable schon mal zugewiesen wurde, geht es nur, wenn der zugewiesene Zellebereich die gleiche größe hat.
Wenn du daß obere Ende des Bereicheies verschiebst, mußt du auch das untere verschieben, also statt Range("B3:B"&Anzahl_Werte + 2) schreibst du Range("B4:B"& Anzahl_Werte + 3)
Anzahl_Werte wird in diesem Fall ja wie eine Absolute Zeilenzahl verwendet und nicht relativ zur zur Startzelle.
zu 4
ok, daß geht in diesem Fall nicht, denn die Zellen sind ja nicht wirklich leer, sondern enthalten Formeln.
In deinem Fall mußt du dann mit dem Autofilter arbeiten (Filter auf "nicht leere" stellen). Auch dieser läßt sich über Makro steuern.
Einfach mal ausprobieren und Makro-Recorder mitlaufen lassen.
zum neuen Problem:
du brauchst doch nur die jeweiligen MIN- und Max-Werte zu ermitteln, entwerder als Excel-Formel in einer definierten Zelle oder direkt in VBA (dann mit der Funktion: Worksheetfunction.Min(Range(...)), bzw. Worksheetfunction.Max(Range(...))
Die Achsen des Diagramms mußt du dann per Makro skalieren, wie das geht kannst du auch per Makro-Rekorder rausfinden.
Gruß, Daniel
AW: VBA Problem
16.08.2006 14:45:13
Peter
Hallo,
noch ein kleiner Nachtrag zur Sache mit dem dynamischen Bereich.
Ich bin den Anweisungen in deinem Beispiel https://www.herber.de/forum/messages/791469.html folgendermaßen gefolgt:
Meine Namen und Daten:
Mein Dateiname: Test1
Diagrammblatt: Koordinaten Darstellung
Tabellenblatt mit x,y Koordinaten: Hilfe
Überschrift der x-Koordinaten: Name
Zelle der Überschrift x-Koordinate: B3
Überschrift der Y-Koordinaten: Werte
Zelle der Überschrift y-Koordinate: C4
Wertebereich der x-Koordinaten von B4 bis B2027
Wertebereich der y-Koordinaten von C4 bis C2027
Mein Eintrag bei Datenquelle, Reihe, X-Werte:
='Test1'!BEREICH.VERSCHIEBEN(Hilfe!$B$4;1;;ANZAHL2(Hilfe!$B:$B)-1;)
Mein Eintrag bei Datenquelle, Reihe, Y-Werte:
='Test1'!BEREICH.VERSCHIEBEN(Hilfe!$C$4;1;;ANZAHL2(Hilfe!$C:$C)-1;)
Schon beim Eintragen meckert Excel das ein Fehler in der Formel ist. Was ist falsch?
Danke im Voraus
Grüße aus Berlin
AW: VBA Problem
16.08.2006 23:07:49
Daniel
Hallo,
in die Wertebereiche des Diagramms dürfen keine Formeln eingetragen werden, nur direkte Zellbezüge oder eben Namen (wenn der Dateiname entsprechend davorgestellt wird)
Eintrag bei Datenquelle: 'Test1.xls'!Werte_x
die Formel muß dann in der Namensdefinition eingebeben werden.
(bei EINFÜGEN - NAMEN - DEFINIEREN)
Eintrag in Namensdefintion zu Werte_x: BEREICH.VERSCHIEBEN(Hilfe!$B$4;1;;ANZAHL2(Hilfe!$B:$B)-1;)
Wenn dir Namen noch nicht so vertraut sind, lies erst mal daß hier:
http://www.online-excel.de/excel/grusel_vba.php?f=7 (Namen 1 bis Namen 3, 4 ist dann Hardcore)
Gruß, Daniel
AW: VBA Problem
16.08.2006 23:33:08
EtoPHG
Hallo Daniel und Peter,
Ich finde den Link von Daniel bezgl. Namensvergabe etwas verwirrlich.
Ist dieser nicht besser ? http://www.online-excel.de/excel/singsel.php?f=69
Dynamischer Bereich ist hier im Zusammenhang mit Pivottabellen gebraucht, lässt sich aber genau so gut für Diagramme anwenden.
Gruss Hansueli
AW: VBA Problem
17.08.2006 16:51:52
Peter
Hallo,
die links haben mir fürs verstehen weitergeholfen, danke.
Die Anpassung des Diagramms auf die Zeichnungsfläche funktioniert auch top.
Leider haut irgendetwas bei der Dynamisierung noch nicht hin.
Namen vergeben und Bereich definieren hat soweit geklappt.
Eintragungen bei Datenquelle auch.
Das Diagramm funktioniert auch bis auf eine Kleinigkeit der 1. Punkt aus Tabellenblatt Hilfe in Zelle B4 bzw. C4 wird nicht angezeigt.
Hier nochmal mein Wertebereich.
Wertebereich der x-Koordinaten von B4 bis B2027
Wertebereich der y-Koordinaten von C4 bis C2027
Ich hab dann mal den Code verändert und die Überschriftzeile mit reingenommen.
=BEREICH.VERSCHIEBEN(Hilfe!$B$3;1;;ANZAHL2(Hilfe!$B:$B)-1;)
Resultat:
1. der 1. Punkt wird mit angezeigt,
2. der letzte Punkt wird zwar angezeigt jedoch nicht nach seinen Merkmalsausprägungen untersucht. Daraufhin hab ich bei den Array-Variablen den Bereich wie folgt angepasst.
von: Range("B4:B"& Anzahl_Werte + 3) auf: Range("B4:B"& Anzahl_Werte + 4)
Dann hat erstmal alles funktioniert:
Nachdem ich die Datei abgespeichert hatte, Excel geschlossen hatten und nun die Datei wieder öffnen wollte verweigert Excel das öffnen mit follgender Fehlermeldung:
"Microsoft Excel für Windows hat ein Problem festgestellt und muss beendet werden"
Die Recherche im Netz ergab das ein Update mit Service Pack 3 helfen könnte?! (hab ich erstmal nicht gemacht)
Jetzt hab ich nochmal neu angefangen, den von dir genannten Code genommen und die Array-Variablen nicht angepasst, abgespeichert, neu geöffnet und siehe da, die Datei lässt sich öffnen.
Wo hab ich Fehler gemacht.
Noch ne neue Sache:
Ich möchte das die Datei sich in
'Ganzer Bildschirm Ansicht
Application.DisplayFullScreen = True
öffnet. Ich hab den Code in
Private Sub Chart_Activate()
reingepackt, reicht aber nicht aus.
Was muss ich machen?
Danke nochmal für eure tolle Hilfe!
Grüße aus Berlin
Peter
AW: VBA Problem
17.08.2006 19:09:57
Peter
Hallo,
ich hab das Problem mit der Dynamisierung lösen können.
Lösungsweg:
Ich habe festgestellt, dass ich den Definitionsbereich der Namen nicht im Blatt "Hilfe" benutzen konnte, da in jeder Zelle Formeln stehen und bei Leerstand = "" mir die Sache mit den Namen und Bereichen nichts nützt, da "" für Excel in dem Fall nicht leer ist.
Zur Lösung bin ich gekommen in dem ich Namen und Bereiche auf das Tabellenblatt mit den Quelldaten gelegt habe.
Funktioniert jetzt top!
Jetzt noch mal zum neuen Problem:
Ich möchte das die Datei sich in
'Ganzer Bildschirm Ansicht
Application.DisplayFullScreen = True
öffnet. Ich hab den Code in
Private Sub Chart_Activate()
reingepackt, reicht aber nicht aus.
Außerdem hab ich noch festgestellt, wenn ich unter Extras, Optionen, Diagramm, Diagramm an Fenstergröße anpassen auswähle kann ich nicht mehr "zoomen".
Schlecht ist auch, wenn ich in der "FullScreen" Ansicht bin, kann ich Excel nicht einfach Minimieren (um z.B. mit einem anderen Programm zu arbeiten) ohne das ich davor die Arbeitsleisten wieder einblende.
Mein Ziel ist es den Bildschirm maximal auszunutzen.
Danke nochmal für eure tolle Hilfe!
Grüße aus Berlin
Peter
AW: VBA Problem
17.08.2006 21:27:54
EtoPHG
Hallo Peter,
Problem Fullscreen:
Mach folgendes
1. Lege eine Forms-Schaltfläche auf das Diagramm (z.B. mit Beschriftung "Bildschirm")
2. Ordne der Schaltfläche das Makro FullScreen zu.
3. Dein Modul2 ergänze mit folgendem Code:

Dim bFullScreen As Boolean
Sub FullScreen()
If bFullScreen Then
bFullScreen = False
Else
bFullScreen = True
End If
Application.DisplayFullScreen = bFullScreen
Application.CommandBars("Chart").Visible = False
End Sub

Die Schalftfläche schaltet jetzt zwischen Fullscreen und NormalScreen um.
Wenn Du noch in Dein Chart_Activate Modul schreibst:

Application.Run ("FullScreen")

sollte der Volle Bildschirm kommen, wenn Du zum Diagramm wechselst.
Gruss Hansueli

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige