Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.04.2024 09:54:17
Durchschnittswerte zwischen Tagen berechnen
16.04.2024 09:51:15
Frage: KPI - Logistik Dashboard
16.04.2024 09:22:11
Wenn Istleer über mehrere Blätter
15.04.2024 23:32:21
Darstellung im IMAGE sehr schlecht
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1192to1196
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
1192to1196
1192to1196
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Shapes dynamisch kopieren - Shape-Objekte

Shapes dynamisch kopieren - Shape-Objekte
carlo
Hallo Zusammen,
Ich habe eine komplexe Aufgabe, welche mir momentan einige Schwierigkeiten bereitet.
Problemstellung:
Ich haben zwei Excelfiles und möchte automatisch diese Shapes (Group, Picture, TextBox) hin und her kopieren ohne zu wissen wie diese einzeln heissen (z. B. Group 31, Picture 12). Das heisst ich sollte irgendwie per VBA herausfinden wie die einzelnen Shapes heissen und diese dann ins andere Excel-File automatisch kopieren.
Gibt es eine Möglichkeit diese einzelnen Shape-Objekte im voraus abzufragen ohne zu wissen, welche in im einten Workbook sind und diese dann automatisch ins andere Workbook zu kopieren.
Vielen Dank für eure Hilfe.
Gruss Carlo

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

Betreff
Benutzer
Anzeige
AW: Shapes dynamisch kopieren - Shape-Objekte
13.01.2011 15:25:03
Josef

Hallo Carlo,
das geht z. B. so.

Sub copyShapes()
  Dim objShp As Object
  Dim objSrcSheet As Worksheet, objTgtSheet As Worksheet
  
  Set objSrcSheet = ThisWorkbook.Sheets(1) 'Quelltabelle
  Set objTgtSheet = Workbooks("Mappe2").Sheets(1) 'Zieltabelle
  
  
  For Each objShp In objSrcSheet.Shapes
    objShp.Copy
    objTgtSheet.Paste objTgtSheet.Cells(objShp.TopLeftCell.Row, objShp.TopLeftCell.Column)
  Next
  
  Set objSrcSheet = Nothing
  Set objTgtSheet = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Shapes dynamisch kopieren - Shape-Objekte
14.01.2011 00:13:21
carlo
Hallo Sepp
Vielen Dank für deine Antwort. Es funktioniert einwandfrei.
Die einzelnen Shapes sind aber leider nicht 1:1 an gleicher Stelle. Gibt es für diese Zeile auch eine Lösung mit .Left und .Top für die einzelne Objekte?
objTgtSheet.Paste objTgtSheet.Cells(objShp.TopLeftCell.Row, objShp.TopLeftCell.Column)
Gruss carlo
AW: Shapes dynamisch kopieren - Shape-Objekte
14.01.2011 01:02:39
Josef

Hallo Carlo,
geht natürlich auch.

Sub copyShapes()
  Dim objShp As Object, objShpCopy As Object
  Dim objSrcSheet As Worksheet, objTgtSheet As Worksheet
  Dim dblLeft As Double, dblTop As Double
  Dim strOldName As String, strNewName As String, strRnd As String
  Dim intIndex As Integer
  
  strRnd = Format(Now, "hhmmss_")
  
  Set objSrcSheet = ThisWorkbook.Sheets(1) 'Quelltabelle
  Set objTgtSheet = Workbooks("Mappe2").Sheets(1) 'Zieltabelle
  
  
  For Each objShp In objSrcSheet.Shapes
    intIndex = intIndex + 1
    With objShp
      strOldName = .Name
      dblLeft = .Left
      dblTop = .Top
      Set objShpCopy = .Duplicate
    End With
    strNewName = strRnd & intIndex
    objShpCopy.Name = strNewName
    objShpCopy.Cut
    With objTgtSheet
      .Paste
      .Shapes(strNewName).Left = dblLeft
      .Shapes(strNewName).Top = dblTop
      .Shapes(strNewName).Name = strOldName
    End With
  Next
  
  Set objShp = Nothing
  Set objShpCopy = Nothing
  Set objSrcSheet = Nothing
  Set objTgtSheet = Nothing
End Sub

Gruß Sepp

Anzeige

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