Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
924to928
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
924to928
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Range-Bereich mit Objekten erkennen

Range-Bereich mit Objekten erkennen
20.11.2007 19:20:00
Jürgen
Hallo Forum,
Es befinden sich mehrere gruppierte Formen und Textfelder eng beieinander auf einer Seite. Diese möchte ich per Kamerafunktion fotografieren.
Dabei soll den aber auch wirklich nur der Bereich Fotografiert werden, in dem sich die Formen befinden.
Meine Frage:
kann man per VBA erkennen, in welchem minimalem Zellbereich (Range) sich die Formen befinden, bzw. über welchem Bereich sich die Gruppe an Formen ausdehnt?
Gruß
Jürgen

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Range-Bereich mit Objekten erkennen
20.11.2007 19:50:00
Jens
Hi,
man kann nur ganze Zellen "fotografieren". Also muss das obere linke Objekt genau an einer
Zellgrenze liegen und das untere rechte mit seiner unteren Kante an einer Zellgrenze, dito
für rechtes Ende. Dann kannst du die TopLeftcell und die BottomRightCell verwenden.
mfg Jens

AW: Range-Bereich mit Objekten erkennen
20.11.2007 19:58:00
Jürgen
Hallo Jens,
das mit den ganzen Zellen ist mir schon klar.
Da sich die Objekgruppe aber mal hier und mal dort mit wechselndem Aufbau und wechselnder Größe befindet, soll per VBA herausgefunden werden, wo sich diese Objektgruppe gerade befindet, bzw, welchen Zellenbereich (Range) sie gerade abdeckt.
Diesen Wechselnden Bereich will ich dann mit der Kamerafunktion fotografieren.
Gruß
Jürgen

Anzeige
AW: Range-Bereich mit Objekten erkennen
20.11.2007 21:19:59
K.Rola
Hallo,
Option Explicit

Sub til()
Dim S1 As Shape, Sh As Shape
Dim C As Integer, R As Long, C1 As Integer, R1 As Long
Set S1 = Me.Shapes(1)
C = S1.TopLeftCell.Column
R = S1.TopLeftCell.Row
C1 = C
R1 = R
For Each Sh In Me.Shapes
If Sh.TopLeftCell.Column  C1 Then
C1 = Sh.BottomRightCell.Column
End If
If Sh.TopLeftCell.Row  R1 Then
R1 = Sh.BottomRightCell.Row
End If
Next
Range(Cells(R, C), Cells(R1, C1)).Select
End Sub


Gruß K.Rola

Anmerkung
20.11.2007 21:21:24
K.Rola
Hallo,
der Code muss in das Modul der relevanten Tabelle.
Gruß K.Rola

Anzeige
Danke
20.11.2007 23:04:50
Jürgen
Hallo K.Rola,
Danke für deine Lösung.
Ich habe sie getestet und sie funktioniert.
Hatte mich inzwischen selbst beigemacht, eine Lösung zu finden, da ich noch eine Bereichsbegrenzung brauchte und das bei meiner Fragestellung nicht mit angegeben hatte.
Außerdem läuft das Modul innerhalb einer UF. Die Var Zeile und Spalte hole ich mir dabei aus

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Zeile = Target.Row: Spalte = Target.Column
End Sub


Nun denn, sie ist etwas holprig und nicht so elegant, wie deine Lösung, funktioniert aber auch.
Sub Sh_Position()
Dim Sh As Shape, rng As Range
Dim OZWert%, UZWert%, LSWert%, RSWert%
Set rng = Range("A8:Z30")
OZWert = 5000: UZWert = 0: LSWert = 500: RSWert = 1
For Each Sh In ActiveSheet.Shapes 'vorhandene Shapes
On Error Resume Next
If Not Intersect(Sh.TopLeftCell, rng) Is Nothing Then
Sh.TopLeftCell.Select
If OZWert > Zeile Then OZWert = Zeile
If LSWert > Spalte Then LSWert = Spalte
End If
Next Sh
For Each Sh In ActiveSheet.Shapes 'vorhandene Shapes
On Error Resume Next
If Not Intersect(Sh.BottomRightCell, rng) Is Nothing Then
Sh.BottomRightCell.Select
If UZWert If RSWert End If
Next Sh
Range(Cells(OZWert, LSWert), Cells(UZWert, RSWert)).Select
End Sub


Werde mal sehen, ob ich deine Lösung entsprechend umgestellt kriege.
Gruß
Jürgen

Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige