---

Traeger_Querschnitt.pdf

Hallo Excel-VBA-Profis ... ;-)

Folgendes Vorhaben ::
Mittels Excel diverse statische Nachweise erstellen mit entsprechender Grafik je nach Eingabe und Auswahl des Benutzers.

Siehe Anlage :: PDF-File ...

Folgendes Problem ::
Selektion bzw. Auswahl der EXCEL-Grafik ?
Wenn ich den Makro-Recorder verwende um die Ansätze bzw. die VBA-Befehle auf die schnelle zu ermitteln, werden für die Auswahl die Excel-Interne Nr. Verwendet
z.B.

Code:

---

Sub Makro1()
    ActiveSheet.Shapes.Range(Array("Arc 467", "Arc 469", "Arc 475", "Arc 477" _
    )).Select
    Selection.ShapeRange.Group.Select
End Sub

---

Meine Frage ::
Ist es möglich vor dem Erstellen der Grafik eine Definition zu Festlegen z.B. Objekt "QUERSCHNITT" ist .... die neu erstellte Grafik ?
Oder ist mein Ansatz komplett falsch und es gibt einfache Methode bzgl. der Grafik-Erstellung ?

Besten Dank ... im Voraus

[Diese Nachricht wurde von edo2000 am 06. Okt. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Edo,

hm, schwierig;-) mal als klitzekleiner Ansatz,
wobei man halt immer die Items(n) der Range() bzw. Shapes() wissen muss,
wenn's denn viele, verschiedene sind/werden sollen.
Wenn dann aber einmal die Gruppe 'benannt' wurde, ist im Nachgang der Zugriff
einfacher. Jedenfalls hab' ich momentan keine bessre Idee für deinen Ansatz.

lg Nancy
--

Code:

---

Sub x()
  Dim x%, y%
  Dim h%, b%, tFl%
  x = 100: y = 100
  h = 300: b = 300: tFl = 20
  With ActiveSheet.Shapes
    .AddLine x, y, x + b, y
    .AddLine x + b, y, x + b, y + tFl
    .Range(Array(1, 2)).Group
    .Item(1).Name = "bla"
  End With
  ActiveSheet.Shapes("bla").Select
  MsgBox ActiveSheet.Shapes("bla").GroupItems.Count & " Elemente gruppiert"
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Traeger_Querschnitt2.pdf

Hi Nancy,

besten Dank für die prompte Antwort ....
Dein Ansatz ist (fast) 'n 10er Wert ;-)

Bis auf folgendes Problem ::
- Wenn man(n) [Frau auch ;-)] den Code erweitert und eine 2. Gruppe zeichnen will, wird bei der Selektion immer auf das 1. Element, in unserem Fall auf "bla1", zurückgegriffen und dieses wird dann mitgrupiert.

... siehe auch Anlage ... Skizze (PDF-File)

Code:

---

Sub x()
  Dim x1%, y1%
  Dim h1%, b1%, tFl1%
  x1 = 100: y1 = 100
  h1 = 300: b1 = 300: tFl1 = 20
  Dim x2%, y2%
  Dim h2%, b2%, tFl2%
  x2 = 200: y2 = 200
  h2 = 300: b2 = 300: tFl2 = 30
  With ActiveSheet.Shapes
    .AddLine x1, y1, x1 + b1, y1
    .AddLine x1 + b1, y1, x1 + b1, y1 + tFl1
    .Range(Array(1, 2)).Group
    .Item(1).Name = "bla1"
  End With
  With ActiveSheet.Shapes
    .AddLine x2, y2, x2 + b2, y2
    .AddLine x2 + b2, y2, x2 + b2, y2 + tFl2
    .Range(Array(1, 2)).Group
    .Item(1).Name = "bla2"
  End With
End Sub

---

------------------
@edo...

Sch.... Umlaute ;-)

[Diese Nachricht wurde von edo2000 am 06. Okt. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

lokal.jpg

Hi Edo,

tja, vertrackte Angelegenheit irgendwie;-)
Das war's in etwa, was ich mit den Items() und Ranges() meinte
und wozu mir leider auch jeglicher Ansatz fehlt.

Hier, beim ersten 'with' hat Activesheet 2 Shapes, diese werden mit
.Range(Array(1, 2)).Group zu einem zusammengefasst, welches halt 2 [Unter] Elemente hat.

Code:

---

With ActiveSheet.Shapes
    .AddLine x1, y1, x1 + b1, y1
    .AddLine x1 + b1, y1, x1 + b1, y1 + tFl1
    .Range(Array(1, 2)).Group
    .Item(1).Name = "bla1"
End With

---

Beim zweiten 'with' hat Activesheet vorm Gruppieren also 3 Shapeitems,
wobei das erste die Gruppe [bla1] darstellt, 2+3 sind die 'neuen' Linien.
Also müsstes irgendwie so lauten:

Code:

---

With ActiveSheet.Shapes
    .AddLine x2, y2, x2 + b2, y2
    .AddLine x2 + b2, y2, x2 + b2, y2 + tFl2
    .Range(Array(2, 3)).Group
    .Item(2).Name = "bla2"
End With

---

Und wenn Du nun noch sowas [sh. Pic] mal via F8 durchgehst,
siehst Du im Lokalfenster, dass es in 's' wieder 2 Shapes [mit je 2 Elementen] gibt.

Aber ob das nun der Weisheit letzter 'Stuss';-) ist, weiss ich nicht so richtig,
denn wenn es nur so ginge [keine rechte Ahnung], erscheint mir das Automatisieren von
ShapeObjekten bzw. das Objektmodell derer dann doch etwas 'heftiger' ;-)

lg Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Beispiel.jpg

Hi Nancy...

wie du schon sagtest 'tja'..
nicht alles ist so einfach wie Lisp ;-)

Die möglichkeit wäre einen Zähler einzubauen um die anzahl der neuen  bzw. der gesamten Objekte zu wissen und die entsprechend zu grupieren...
aber was wen der Benutzer ein Objekt hinzufügt usw ... auch nicht das wahre ... Da es mehrere Objekte werden (siehe Beispiel ...) ist mir die Selektierbarkeit schon von Bedeutung.

Habe es im momment so gelöst, das ich die Zeichenarbeit ausgelagert habe, Extra-Register "Zeichenbrett" ;-) (komplett leer) und dann über "Cut" und "Paste" die einzelnen Gruppen Verschiebe oder Reinlade ....

Siehe da ... ein Wunder "Die Objekt/Gruppen Benennung bleibt bestehen und Selektierbar" .. ;-)

Code:

---

Sub x()
Sheets("Zeichenbrett").Select
  Dim x1%, y1%
  Dim h1%, b1%, tFl1%
  x1 = 100: y1 = 100
  h1 = 300: b1 = 300: tFl1 = 20
  With ActiveSheet.Shapes
    .AddLine x1, y1, x1 + b1, y1
    .AddLine x1 + b1, y1, x1 + b1, y1 + tFl1
    ActiveSheet.Shapes().SelectAll
    Selection.ShapeRange.Group.Select
    .Item(1).Name = "bla1"
  End With
  ActiveSheet.Shapes("bla1").Select
  Selection.Cut
    Sheets("Mappe").Select
    Range("B5").Select
    ActiveSheet.Paste
Sheets("Zeichenbrett").Select
  Dim x2%, y2%
  Dim h2%, b2%, tFl2%
  x2 = 200: y2 = 200
  h2 = 300: b2 = 300: tFl2 = 30
  With ActiveSheet.Shapes
    .AddLine x2, y2, x2 + b2, y2
    .AddLine x2 + b2, y2, x2 + b2, y2 + tFl2
    .AddLine x2, y2 + tFl2, x2 + b2, y2 + tFl2
    .AddLine x2, y2, x2, y2 + tFl2
    ActiveSheet.Shapes().SelectAll
    Selection.ShapeRange.Group.Select
    .Item(1).Name = "bla2"
  End With
  ActiveSheet.Shapes("bla2").Select
  Selection.Cut
    Sheets("Mappe").Select
    Range("B10").Select
    ActiveSheet.Paste
End Sub
Sub Del_bla1()
    ActiveSheet.Shapes("bla1").Select
    Selection.Delete
End Sub
Sub Del_bla2()
    ActiveSheet.Shapes("bla2").Select
    Selection.Delete
End Sub

---

Biss'l umständlich aber es Funzt'...

Beste Grüße von hier...

------------------
@edo...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Querschnitt.zip

hallo,

wie wäre es ohne vba ... siehe anhang!

thorsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP