Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
648to652
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
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

shapes von sheet1 nach sheet2 kopieren

shapes von sheet1 nach sheet2 kopieren
07.08.2005 15:57:12
sheet1
Hallo Formler!
irgendwie bin ich gerade am verzweifeln:
datei1/blatt1 soll nach datei2/blatt1 kopiert werden (nur daten/formate/shapes)
mit den daten und formaten ist das ja kein problem:
Workbooks("datei1.xls").Worksheets("blatt1").Cells.Copy
With Workbooks("datei2.xls").Worksheets("blatt1").Cells
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
wie bekomme ich jetzt aber die shapes inkl. positionen noch kopiert?
Workbooks("datei1.xls").Worksheets("blatt1").Shapes.Range(Array("Picture 1", "Picture 2", "Text Box 1")).Copy
ActiveWorkbook.ActiveSheet.Paste
funktionierte zwar als aufzeichnung (mit select) aber hier ohne wirkung (kein ergebnis/keine fehlermeldung)
HOLZHAMMERMETHODE:
komplett kopieren und anschliessend mit werten überschreiben geht auch nicht - die formeln sind immer noch da (warum eigentlich!?)
Workbooks("datei1.xls").Worksheets("blatt1").Cells.Copy
Workbooks("datei2.xls").Worksheets("blatt1").Cells.Paste
Application.CutCopyMode = False
Workbooks("datei1.xls").Worksheets("blatt1").Cells.Copy
With Workbooks("datei2.xls").Worksheets("blatt1").Cells
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
würde mich über hilfe und lösungsvorschläge freuen ;-)
liebe grüße
steve.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: shapes von sheet1 nach sheet2 kopieren
07.08.2005 16:50:50
sheet1
Hallo Steve!
Prinzipiel könnte das so laufen.
Option Explicit

Sub CopyShapesAndPlaceIt()
    Dim shp As Shape
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim x As Double, y As Double
    
    
    Set ws1 = Workbooks("datei1.xls").Worksheets("blatt1")
    Set ws2 = Workbooks("datei2.xls").Worksheets("blatt1")
    
    For Each shp In ws1.Shapes
        
        With shp
            x = .Left
            y = .Top
            .Copy
        End With
        
        wb2.Sheets(1).Paste
        
        With ws2.Shapes(ws2.Shapes.Count)
            .Left = x
            .Top = y
        End With
        
    Next
    
End Sub


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!


Anzeige
AW: shapes von sheet1 nach sheet2 kopieren
07.08.2005 17:14:57
sheet1
hmm, Danke erstmal!
leider funktioniert es so nicht:
Kein kopieren. Keine Fehlermeldung.
Set ws1 = Workbooks("datei1.xls").Worksheets("blatt1")
Set ws2 = Workbooks("datei2.xls").Worksheets("blatt1")
ergibt (natürlich mit den richtigen Werten):
ws1 = "nothing"
ws2 = "nothing"
Es muss auch nicht unbedingt dynamisch sein, es muss einfach (immer das gleiche) Bild bzw. Textfeld mitkopiert werden.
Hintergrund:
Rechnungsformular (mit Briefkopf als Picture & Textfeld) soll als Kopie abgespeichert werden (nur Daten und Briefkopf, ohne Formeln/VBA) bisher bekomme ich eben nur die Rechnung abgespeichert ohne Briefkopf.
Anzeige
DANKE, JOSEF !! Hat prima geklappt!
08.08.2005 23:28:10
steve
Sorry, dass ich mich erst jetzt melde, war technisch bedingt offline...
Vielen Dank für deine Hilfe!
Grüsse aus dem Hohenloher Land
Steve.
Korrektur!
07.08.2005 17:07:12
Josef
Hallo Steve!
Da war noch ein Fehler drin!
Option Explicit

Sub CopyShapesAndPlaceIt()
    Dim shp As Shape
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim x As Double, y As Double
    
    
    Set ws1 = Workbooks("datei1.xls").Worksheets("blatt1")
    Set ws2 = Workbooks("datei2.xls").Worksheets("blatt1")
    
    For Each shp In ws1.Shapes
        
        With shp
            x = .Left
            y = .Top
            .Copy
        End With
        
        ws2.Paste
        
        With ws2.Shapes(ws2.Shapes.Count)
            .Left = x
            .Top = y
        End With
        
    Next
    
End Sub


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!


Anzeige
AW: Korrektur! >> trotzdem kein Erfolg! s.o.
07.08.2005 17:20:19
steve
trotzdem gleiches Problem:
ws1 bzw ws2 = nothing
AW: Korrektur! >> trotzdem kein Erfolg! s.o.
07.08.2005 18:33:13
Josef
Hallo Steve!
Wie und wo, setzt du den Code ein?
Hast du ein "On Error Resume Next" irgendwo stehen?
Wenn ja, dann nimm es mal raus!
Gruß Sepp
P.S.: Rückmeldung nicht vergessen!


Teilerfolg...
07.08.2005 19:07:28
steve
Hallo Josef,
Danke nochmal!
jep, 'on error resume next' war gesetzt. hab´s auskommentiert.
nun werden die shapes kopiert, allerdings bricht for-next beim (vermutl. letzten) Durchlauf ab mit 'objektdefinierter fehler' (debug steht auf .copy)
außerdem läuft die schleife 20x durch, habe aber nur:
4 Bilder
1 Textfeld
3 Commandbuttons
2 Listfelder
also 10 shapes, oder zählt das sonst noch was dazu?
gut wäre außerdem, wenn _nur_ die Bilder / das Textfeld kopiert wird ohne Buttons/Listboxen.
Anzeige
AW: Teilerfolg...
07.08.2005 19:19:56
Josef
Hallo Steve!
Zu den Shapes zählt alles was du in eine Tabelle einfügst!
Probier's mal so!
Option Explicit

Sub CopyShapesAndPlaceIt()
    Dim shp As Shape
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim x As Double, y As Double
    
    
    Set ws1 = Workbooks("datei1.xls").Worksheets("blatt1")
    Set ws2 = Workbooks("datei2.xls").Worksheets("blatt1")
    
    For Each shp In ws1.Shapes
        
        If shp.Type = 13 Or shp.Type = 17 Then
            
            With shp
                x = .Left
                y = .Top
                .Copy
            End With
            
            ws2.Paste
            
            With ws2.Shapes(ws2.Shapes.Count)
                .Left = x
                .Top = y
            End With
            
        End If
        
    Next
    
End Sub


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige