Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1320to1324
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
Inhaltsverzeichnis

funktion Linienlänge summieren

funktion Linienlänge summieren
05.07.2013 12:41:39
stefan
Hallo Zusammen,
ich habe eine Funktion vom Udo (aus dem Pott :-)) bekommen, welches mir
in einen Bereich die Längen aller Linien summiert.
Function LaengeLinien(rng As Range)
Application.Volatile
Dim shp As Shape, l As Single
For Each shp In ActiveSheet.Shapes
With shp
If .Type = msoLine Then
If Not Intersect(rng, .TopLeftCell) Is Nothing _
And Not Intersect(rng, .BottomRightCell) Is Nothing Then
l = l + Sqr(.Height ^ 2 + .Width ^ 2)
End If
End If
End With
Next
LaengeLinien = l
Application.Volatile
End Function
Habe nun das Problem, dass die Werte der Funktion, sobald ich das Tabellenblatt wechsle auf #WERT! zurückspringt...
Kann mir jemad sagen, was ich falsch, bzw. wie ich dies verhindern kann ?
Gruß
Stefan

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

Betreff
Datum
Anwender
Anzeige
AW: funktion Linienlänge summieren
05.07.2013 13:03:57
ransi
Hallo
Versuch mal so:
For Each shp In rng.parent.Shapes
.
.
.
next
ransi

AW: funktion Linienlänge summieren
05.07.2013 13:09:54
stefan
des Rätsels Lösung !
Besten Dank ransi
:-)
Stefan

AW: funktion Linienlänge summieren
05.07.2013 13:20:35
Luschi
Hallo Stefan,
wenn #WERT! kommt, dann ist da noch ein anderer Fehler; eigentlich muß '0' herauskommen beim _ Blattwechsel - da ja ActiveSheet jetzt auf ein anderes Blatt zeigt. Mach es so:

Function LaengeLinien(rng As Range) As Single
Application.Volatile
Dim shp As Shape, l As Single
For Each shp In rng.Parent.Shapes
With shp
If .Type = msoLine Then
If Not Intersect(rng, .TopLeftCell) Is Nothing _
And Not Intersect(rng, .BottomRightCell) Is Nothing Then
l = l + Sqr(.Height ^ 2 + .Width ^ 2)
End If
End If
End With
Next
LaengeLinien = l
End Function

Gruß von Luschi
aus klein-Paris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige