Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 11:49:48
VAB und Bedingte Formatierung nimmt die Farbe im Makro nicht
26.04.2024 11:38:46
Acrobat PDF Formularfelder mit Excel ausfüllen
26.04.2024 11:23:04
zählen wenn - aber nur die selektierten Zeilen
26.04.2024 10:08:11
Summieren von Zellen mit bedingter Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1064to1068
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1064to1068
1064to1068
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Chart und Linien programmieren

Chart und Linien programmieren
03.04.2009 15:53:06
Timmy
Liebe Excler,
ich habe eine Darstellung in Excel erstellt. Dafuer habe ich Auto-Shape-Textboxen und Linien (Connectors aus den Auto Shapes) verwendet.
Ich habe eine beispielhafte Datei angehaengt:
https://www.herber.de/bbs/user/60980.xls
Gibt es eine Moeglichkeit, diese Grafik zu programmieren? Wirklich toll waere natuerlich, wenn ich beim Anklicken einer Textbox nur deren Verlinkungen sehe. Ich habe mein Anliegen im Beispiel auch nochmal kurz erlautert.
Ich hoffe, dass es eine Loesung gibt und bin dankbar fuer jeden Ratschlag!
Viele Gruesse,
Timmy

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Chart und Linien programmieren
04.04.2009 15:08:14
ChristianM
Hallo Timmy,
hier ein Beispiel. Solange du nur mit Connectors und nicht mit Linien arbeitest, müsste das laufen.
Das Makro "InitShapes" nur einmal am Anfang ausführen, bzw. wenn weitere Felder dazugekommen sind.
Farbe zurücksetzen durch Klick auf ein shape ohne Connectors.
Gib mir Bescheid, wie du damit zurecht kommst.
Grüße
ChristianM 

Option Explicit
Sub InitShapes()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If Not sh.Connector Then sh.OnAction = "HighlightConnectors"
Next
End Sub
Sub HighlightConnectors()
Dim sh As Shape, shObj As Shape
Dim shB As Shape, shE As Shape
Set shObj = ActiveSheet.Shapes(Application.Caller)
For Each sh In ActiveSheet.Shapes
If sh.Connector Then
sh.Line.Weight = 0.75
sh.Line.ForeColor.SchemeColor = 64
On Error Resume Next
Set shB = sh.ConnectorFormat.BeginConnectedShape
Set shE = sh.ConnectorFormat.EndConnectedShape
If shB.Name = shObj.Name Or shE.Name = shObj.Name Then
sh.Line.Weight = 1.25
sh.Line.ForeColor.SchemeColor = 10
End If
On Error GoTo 0
End If
Next
End Sub


Anzeige
AW: Chart und Linien programmieren
06.04.2009 14:20:40
Timmy
Hallo Christian,
vielen Dank fuer deine Hilfe... bin erst gerade wieder an den PC im Buero gekommen!
Ich habe deinen Code soeben ausprobiert, jedoche gibt er mir in folgender Zeile einen Error:
..........
....
Set shObj = ActiveSheet.Shapes(Application.Caller)
......
Run-time error '13':
type mismatch
Vllt ist es nur ein kleiner Fehler, ich weiss jedoch nicht wie ich diesen ausbessern koennte.
Ich habe die Datei mit dem Code angehaengt. Vllt kannst sie dir nochmal anschauen!
https://www.herber.de/bbs/user/61025.xls
Vielen Dank und viele Gruesse aus Amerika!!
Timmy
Anzeige
AW: Frage offen vergesse... sorry/Gruss!!!
06.04.2009 14:21:17
Timmy
AW: Frage offen vergesse... sorry/Gruss!!!
06.04.2009 16:49:02
ChristianM
Hallo,
der Code muss in ein allg. Modul (im VBEditor: einfügen - Modul).
Ob das dein Problem löst kann ich allerdings nicht versprechen, da ich nicht weiß, ob in der amerikanischen Version ein anderer Syntax für "Application.Caller" existiert...
Gruß
Christian
AW: Frage offen vergesse... sorry/Gruss!!!
06.04.2009 16:55:53
Timmy
Hallo Christian,
der Code sieht gut aus und ich bin ueberzeugt, dass er funktioniert, nur haengt das wohl wirklich mit der amerikanischen Version zusammen, dass er mir den Fehler ausgibt.
Muss schauen, dass ich irgendwie zu einer anderen Loesung komme.
Vielen Dank fuer deine Bemuehungen Christian...
Gruesse
Timmy
Anzeige
schau mal in der VBA Hilfe...
06.04.2009 19:24:10
ChristianM
...nach Caller
ich kenn leider keine andere Möglichkeit, das angeklickte Shape abzufragen, als mit "Application.Caller"
good luck
Christian
Vielen Dank...werde mich bei Erfolg melden ;-) owT
06.04.2009 19:39:58
Timmy
AW: Vielen Dank...werde mich bei Erfolg melden ;-) owT
07.04.2009 20:52:07
Christian
Hallo nochmal,
wenn es wirklich an diesem "Caller" hängen sollte, kannst du natürlich auch für jedes Shape ein eigenes Marko schreiben und jedem Shape anschließend das jeweilige Makro zuordnen. Ist natürlich sehr umständlich. Als Beispiel der Code für "Kunde A" und "Kunde B". Wie gesagt, muss der Code in ein Standardmodul.
Gruß
Christian 

Option Explicit
Sub Highlight6()
'AutoForm 6 -> Kunde B
Dim sh As Shape, shObj As Shape
Set shObj = ActiveSheet.Shapes("AutoForm 6")
For Each sh In ActiveSheet.Shapes
If sh.Connector Then
sh.Line.Weight = 0.75
sh.Line.ForeColor.SchemeColor = 64
With sh.ConnectorFormat
If .BeginConnectedShape.Name = shObj.Name _
Or .EndConnectedShape.Name = shObj.Name Then
sh.Line.Weight = 1.25
sh.Line.ForeColor.SchemeColor = 10
End If
End With
End If
Next
End Sub
Sub Highlight8()
'AutoForm 8 -> Kunde A
Dim sh As Shape, shObj As Shape
Set shObj = ActiveSheet.Shapes("AutoForm 8")
For Each sh In ActiveSheet.Shapes
If sh.Connector Then
sh.Line.Weight = 0.75
sh.Line.ForeColor.SchemeColor = 64
With sh.ConnectorFormat
If .BeginConnectedShape.Name = shObj.Name _
Or .EndConnectedShape.Name = shObj.Name Then
sh.Line.Weight = 1.25
sh.Line.ForeColor.SchemeColor = 10
End If
End With
End If
Next
End Sub


Anzeige
oder wenigstens ein bischen eleganter...
07.04.2009 21:07:21
ChristianM
wie folgt: (für weitere Shapes ergänzen)
Gruß
Christian 

Option Explicit
Sub Form_6()
'AutoForm 6 -> Kunde B
Call HighlightConnectors("AutoForm 6")
End Sub
Sub Form_8()
'AutoForm 8 -> Kunde A
Call HighlightConnectors("AutoForm 8")
End Sub
Sub HighlightConnectors(strShape As String)
Dim sh As Shape, shObj As Shape
Set shObj = ActiveSheet.Shapes(strShape)
For Each sh In ActiveSheet.Shapes
If sh.Connector Then
sh.Line.Weight = 0.75
sh.Line.ForeColor.SchemeColor = 64
With sh.ConnectorFormat
If .BeginConnectedShape.Name = shObj.Name _
Or .EndConnectedShape.Name = shObj.Name Then
sh.Line.Weight = 1.25
sh.Line.ForeColor.SchemeColor = 10
End If
End With
End If
Next
End Sub


Anzeige
AW: oder wenigstens ein bischen eleganter...
07.04.2009 22:48:18
Timmy
Hallo Christian,
vielen Dank fuer deinen Einsatz, den ich sehr zu schaetzen weiss.
Excel gibt mir (warum auch immer) einen Fehler in folgender Zeile:
Set shObj = ActiveSheet.Shapes(strShape)
Run-time error '-2147024809 (80070057):
The item with the specified name wasn't found.
Bis dahin laeuft der Code, zumindest meckert er nicht.
Dabei habe ich die Makros auch entsprechend zugewiesen,...
Ich habe nun seit kurzem folgende Loesung, bei der mir ein anderer Excelexperte (Tino) tatkraeftig zur Seite stand. Und die moechte ich dir nicht vorenthalten:
https://www.herber.de/bbs/user/61065.xls
Eine super Loesung, mit der ich nun arbeiten werde.
Da ich in 4 Wochen mal wieder in Deutschland bin (wenn auch nur kurz), nehme ich deinen Code mit ins Gepaeck, und teste es auf meinem dortigen Rechner... bin gespannt, ob sich auf der dt. Version dann was tut!! Kann dir dann auch nochmal feedback geben....
Vielen Dank nochmal, und ich hoffe ich kann dir auch mal behilflich sein!!!!
Viele Gruesse
Timmy
Anzeige
AW: oder wenigstens ein bischen eleganter...
08.04.2009 10:46:12
ChristianM
Ja, die Namen wie "AutoForm 6" etc. musst du nochmal prüfen und ggf. anpassen.
Die Lösung von Tino mit Hiilfstabelle ist noch umständlicher, aber wenn sie läuft, prima.
Gruß
Christian
AW: oder wenigstens ein bischen eleganter...
08.04.2009 14:40:12
Timmy
Hi Christian (bzw. guten Morgen bei mir^^),
habe mich mit deinem Code noc lange beschaeftigt und hingekriegt.
Er markiert mir alle Verbindungen, die zu der Form passen rot ;-)
klappt wikrlich prima... das einzig kleine Problemchen ist, dass ich dann die Farbe nicht mehr weg klicken kann, ausser ich klicke auf eine andere Box, aber dann sind dort die Linien wieder rot!
Aber echt super Christian, vielen Dank fuer deine Hilfe!!!!
Gruss
Timmy
Anzeige
Alle aus
08.04.2009 16:21:26
ChristianM
Hallo Timmy,
einfach ein weiteres Shape (Viereck) einfügen, dass keine Connectors hat und das entsprechende Makro erzeugen und zuweisen. Wenn du darauf klickst, werden alle Connectors wieder schwarz.
Gruß
Christian
AW: Alle aus
08.04.2009 16:43:14
Timmy
Hallo Christian,
super, funktioniert ebenfalls.
Dein zweiter Code ist zwar "eleganter" und viel kuerzer, jedoch bevorzuge ich deinen ersten Code, da ich hier jede Box bzw. die entsprechenden Connectors einzeln bzgl. Farbe, Dicke,.... bearbeiten kann ;-)
danke sehr,
Gruesse
Timmy
der Vollständigkeit halber...
08.04.2009 20:35:51
ChristianM
...du kannst natürlich auch die Linienbreite und Farbe als Parameter übergeben.
hier ein Beispiel für "Autoform 6" und "Autoform 8". Farbe ausschalten funktioniert hier durch erneuten Klick auf das Shape mit gefärbten Linien.
Gruß
Christian 

Option Explicit
Sub Form_6()
'AutoForm 6 -> Kunde B
Call HighlightConnectors("AutoForm 6", 1.25, 10)
End Sub
Sub Form_8()
'AutoForm 8 -> Kunde A
Call HighlightConnectors("AutoForm 8", 2.25, 4)
End Sub
Sub HighlightConnectors(strShape As String, sngWeight As Single, lngColor As Long)
Dim sh As Shape, shObj As Shape
Dim sngWght As Single, lngClr As Long
Const WHGT As Single = 0.75     'default line weight
Const CLR As Long = 64          'default color = xlAutomatic
Set shObj = ActiveSheet.Shapes(strShape)
For Each sh In ActiveSheet.Shapes
If sh.Connector Then
sngWght = WHGT
lngClr = CLR
With sh.ConnectorFormat
If .BeginConnectedShape.Name = shObj.Name _
Or .EndConnectedShape.Name = shObj.Name Then
If sh.Line.Weight = WHGT _
And sh.Line.ForeColor.SchemeColor = CLR Then
sngWght = sngWeight
lngClr = lngColor
End If
End If
End With
sh.Line.Weight = sngWght
sh.Line.ForeColor.SchemeColor = lngClr
End If
Next
End Sub


Anzeige
AW: du hasts einfach drauf...
08.04.2009 21:10:00
Timmy
... vielen Dank, das klappt spitze ;-)
Hast dir n schoenes Osternwochenende verdient mit hoffentlich vielen Ostereiern ;-))
Viele Gruesse aus Amerika,
Timmy

Links zu Excel-Dialogen

TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige