Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
648to652
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
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Farbkreise anhand von Werten erstellen

Farbkreise anhand von Werten erstellen
11.08.2005 09:33:24
Werten
Hallo Herbert. (et al)
Kannst Du mir bitte noch auf den letzten Eintrag (s.u.) antworten, falls Du die Zeit findest? Das wäre klasse.
Viele Grüße
Heider
Vielen Dank, dass Du Dir so viel Mühe gibst mit einem Neuling!
Das Skript ist echt klasse.
Ich habe nun versucht es in eine andere Mappe zu integrieren, die ich dann nutzen möchte.
Leider klappt es nicht ganz und einige Kreise haben keine bzw. die falsche Farbe.
Ich habe es online gestellt.

Die Datei https://www.herber.de/bbs/user/25484.xls wurde aus Datenschutzgründen gelöscht


2 Fragen habe ich noch.
1. Ich habe rausgefunden, dass der msoShapeOval Befehl das Format
msoShapeOval X Koordinate, Y Koordinate, X Dimension, Y Dimension hat.
Wieso arbeitet das Skript mit:
ActiveSheet.Shapes.AddShape msoShapeOval, 273, 392, 30, 30
bzw. wie muss man x und y für andere Tabellen ändern?
2. Wozu braucht man die Funktion "Nummer des ersten Kreises ermitteln"
und muss ich diese eventuell auch anpassen?
Viele Grüße
Heider
----------Sub shp_einf()----------------------------------
'?
ActiveSheet.Shapes.AddShape msoShapeOval, 273, 392, 30, 30
For Each shp In ActiveSheet.Shapes
anz = anz + 1
'?
If shp.Left = 273 Then
x = anz
Exit For
End If
Next
------------Sub anz_obj_ermitteln()
'?
ActiveSheet.Shapes.AddShape msoShapeOval, 273, 392, 30, 30
For Each shp In ActiveSheet.Shapes
anz = anz + 1
'?
If shp.Left = 273 Then
MsgBox anz
Exit For
End If
Next
Die aktuelle Mappe:

Die Datei https://www.herber.de/bbs/user/25513.xls wurde aus Datenschutzgründen gelöscht

Kannst Du mir vielleicht bei folgendem Excel-Problem helfen?
Ich würde mich sehr freuen, wenn Du es Dir mal anschauen würdest.
Also…
Ich habe eine Quell-Tabelle mit einer Auflistung von Beträgen (in Euro), die
vom Kunden und gekauftem Produkt abhängen.
Diese Quelltabelle soll in eine Zieltabelle (ganz unten im JPEG Bild)
umgewandelt oder überführt werden, die dann die Beträge nicht nur als Zahl
sondern auch als farbige Kreise darstellt. Bei positiven Beträgen ein grüner
Kreis und bei negativen ein roter Kreis. Die Höhe des Wertes bestimmt die Größe
des jeweiligen Kreises.
Die Herausforderung ist wie folgt:
Primär:
Wie kann man einen Automatismus einrichten, der die Tabelle bzw. die Beträge
als farbige Kreise darstellt? Die Tabelle müsste nach Maximum- und Minimum-
Werten durchgesucht werden – Diese Werte bestimmen dann die maximale Größe
eines Kreises – Dementsprechend müssten die kleineren Werte bzw. Kreise größer
oder kleiner und rot oder grün dargestellt werden. Das Tabellenfeld indem sich
der Betrag befindet, müsste an die Größe des Kreises angepasst werden (wie in
der letzten Tabelle im JPEG-Bild).
Hinweis: Mit der Excel-Funktion Blasendiagramm lässt es sich leider nicht
realisieren-habe es schon ausgiebig probiert.
Die Lösung des Primären Problems wäre schon viel wert.
Sekundär:
Die Quelltabelle enthält die Beträge, die Kunden und Produkten zugeordnet sind,
nicht in Form von Pull-Down-Menüs (wie in der mittleren Tabelle im JPEG)
sondern als eine lange Liste von Kunden und Produkten die aufgeführt sind und
denen dementsprechend Beträge zugeordnet sind (ähnlich wie in der ersten
Tabelle im JPEG-Bild) Also wie kann ich Werte aus einer Quelltabelle oder einem
Pulldown einer Quelltabelle in eine Pulldown meiner Zieltabelle überführen?
Vielleicht hast Du ja ne Idee?
Vielen Dank im Voraus schon mal !
Grüße
Heider
##############################################################################
Kompletter Forumsbeitrag unter
https://www.herber.de/index.html?https://www.herber.de/forum/archiv/648to652/t648405.htm

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Farbkreise anhand von Werten erstellen
11.08.2005 11:01:42
Werten
hallo Heider,
der Link zum alten Beitrag hätte genügt...
gruß Herbert
AW: Farbkreise anhand von Werten erstellen
11.08.2005 12:51:51
Werten
hallo Heider,
ich habe es jetzt etwas geändert...
habe es ins Makro reingeschrieben,
was du ändern mußt,wenn du es in einem
anderen Bereich anwenden willst...
das Löschen-Makro mußt du gegebenfalls auch anpassen...
https://www.herber.de/bbs/user/25523.xls
gruß Herbert
AW: Farbkreise anhand von Werten erstellen
15.08.2005 10:58:49
Werten
noch eine andere Version...


Sub shp_yyy()
Dim dm!, s%, t!, l!, z%, i%, x%
Dim shp As Shape
x = 1
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
  For i = 5 To 20       'hier die Zeilen anpassen
    For s = 8 To 20     'hier die Spalten anpassen
      With .Cells(i, s)
          .Activate
        t = .Top
        l = .Left
        z = .Value
      End With
      If z < 0 Then dm = z - (z + z / 5) Else dm = z / 5
      If .Cells(i, s) <> "" Then
         Set shp = .Shapes.AddShape(msoShapeOval, l + 5, t + 5, dm, dm)
         If Cells(i, s) > 0 Then
           shp.Fill.ForeColor.SchemeColor = 17
         End If
         
         If Cells(i, s) < 0 Then
           shp.Fill.ForeColor.SchemeColor = 10
         End If
         x = x + 1
      End If
   Next
Next
End With
Application.ScreenUpdating = True
Set shp = Nothing
End Sub

     gruß Herbert
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige