Office: (Office 2010) xlSheetType bei Erstellen von Diagrammen per VBA

Helfe beim Thema xlSheetType bei Erstellen von Diagrammen per VBA in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich möchte mehrere Sheets aus einem Arbeitsblatt in ein neues kopieren. Dieses wird dann gespeichert und geschlossen - zur Archivierung. Die... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Icebreak3r, 30. Juni 2016.

  1. Icebreak3r Erfahrener User

    xlSheetType bei Erstellen von Diagrammen per VBA


    Hallo,

    ich möchte mehrere Sheets aus einem Arbeitsblatt in ein neues kopieren. Dieses wird dann gespeichert und geschlossen - zur Archivierung. Die mitkopierten Diagramme (per VBA erstellt) behalten aber ihre Hyperlinks, was ich unterbinden möchte.

    Deshalb dachte ich mir, ich unterscheide beim kopieren zwischen xlChart und xlWorksheet, allerdings sind die Diagramme als xlExcel4IntlMacroSheet definiert. Und für diesen SheetType funktioniert die Methode CopyPicture leider nicht, was das Problem mit den Hyperlinks lösen könnte.

    Nun habe ich mir verschiedene Ansätze überlegt:

    - Die Diagramm als xlChart definieren (Weiß nicht wie das geht)
    - Die neue Datei so definieren, dass Verknüpfung nicht aktiviert werden können (weiß ich auch nicht wie das geht)
    - Eine andere Variante für das Kopieren von Diagrammen ohne Hyperlinks wäre die andere (hab keine Idee dazu)

    Falls jemand weiß, wie das gehen könnte, wäre ich sehr dankbar.

    Gruß Ice


    Edit: Selbst mit Hand erstellte Diagramme werden nicht als Typ xlChart definiert.

    Edit2: Habe mir mittlerweile eine andere Möglichkeit überlegt und zwar mit SaveAs, allerdings ist hier dann die Makro-Datei nicht mehr geöffnet, sondern die Kopie davon.

    Edit3: Habe nun das ganze umgegangen, in dem ich die Makrodatei speichere, dann als Kopie speichere (als .xlsx), dann das Orignal wieder öffne und die Kopie schließe.

    Nicht schön, aber es funktioniert. Falls jemand eine schönere Lösung hat (und die Zeit dafür) wäre ich trotzdem noch dankbar!
     
    Zuletzt bearbeitet: 30. Juni 2016
    Icebreak3r, 30. Juni 2016
    #1
  2. Beverly
    Beverly Erfahrener User
    Hi,

    was verstehst du unter "die Diagramme behalten ihre Hyperlinks"? In Diagrammen gibt es keine Hyperlinks, höchsten Zellbezüge zum Wertebereich.
    Wie kopierst du die Tabellenblätter?

    Bis später,
    Karin
     
    Beverly, 30. Juni 2016
    #2
  3. Icebreak3r Erfahrener User
    Hey,
    ja ich meine tatsaächlich die Zellbezüge. Ich habe die Tabellenblätter mit:

    For Each obj In Application.Sheets
    If obj.Name <> "Makro" Then
    If obj.Type = xlChart Then
    WbkQ.Sheets(lngs).CopyPicture _
    After:=WbkZ.Sheets(lngAnzahl)
    lngs = lngs + 1
    lngAnzahl = lngAnzahl + 1
    Else
    WbkQ.Sheets(lngs).Copy _
    After:=WbkZ.Sheets(lngAnzahl)
    lngs = lngs + 1
    lngAnzahl = lngAnzahl + 1
    End If
    End If
    Next obj

    kopiert.
     
    Icebreak3r, 5. Juli 2016
    #3
  4. Beverly
    Beverly Erfahrener User

    xlSheetType bei Erstellen von Diagrammen per VBA

    Hi,

    nur mal zur Klarstellung: ein Sheet kann sowohl ein Arbeitsblatt (bzw. auch Tabelle oder Tabellenblatt genannt) als auch ein Diagrammblatt sein und beide Typen befinden sich in einem Workbook (Arbeitsmappe). Man sollte schon die Bezeichungen korrekt verwenden, weil dies sonst zu Missverständnissen führen kann.

    Wenn ich das richtig sehe, sollen alle Arbeitsblätter außer das mit dem Namen "Makro" und alle Diagrammblätter in die neue Arbeitsmappe kopiert werden?


    Code:
    Sub SheetsKopieren()
        Dim lngTabs As Long
        Dim lngZaehler As Long
        lngZaehler = 1
        Dim arrTabellen()
        ReDim arrTabellen(1 To Sheets.Count - 1)
        For lngTabs = 1 To Sheets.Count
            If Sheets(lngTabs).Name <> "Makro" Then
                arrTabellen(lngZaehler) = lngTabs
                lngZaehler = lngZaehler + 1
            End If
        Next lngTabs
        Sheets(arrTabellen).Copy
    End Sub
    
    
    Bis später,
    Karin
     
    Beverly, 5. Juli 2016
    #4
  5. Icebreak3r Erfahrener User
    Hi,

    danke schonmal für die Hilfe,

    soweit ich das sehe, habe ich Bezeichnungen korrekt verwendet (bis auf Hyperlink (Excel nennt es auch Verknüpfung).

    Ziel ist es, bei dem Kopiervorgang die Diagramme ohne Zellbezug zu kopieren. Bzw. den Zellbezug automatisch zu ändern, da ich das Tabellenblatt mit den Daten mitkopiere.

    Hier mal mein gesamter Code mit allen Varianten, die ich bisher ausprobiert habe. Auch mit Save As löse ich mein Problem nicht, der Zellbezug besteht weiterhin zur original Datei xlSheetType bei Erstellen von Diagrammen per VBA :(


    Code:
    Private Sub CommandButton3_Click()
    
    '***    Auswertung exportieren
    Dim strZiel As String, strQuel As String
    Dim strAnfang As String, strEnde As String, strPfad As String, strName As String
    Dim WbkZ As Workbook, WbkQ As Workbook
    Dim lngAnzahl As Long, lngs As Long
    Dim strs As String, strName2 As String
    Dim obj As Object
    
    '***    Quell-Arbeitsblatt festlegen
    Set WbkQ = ThisWorkbook
    
    '***    Kontrolle, ob Auswertung vorhanden ist
    If WbkQ.Sheets.Count > "1" Then
    
    Else
    MsgBox "Keine Auswertung vorhanden!", vbCritical
    Exit Sub
    End If
    
    '***    Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    '***    Zeitbereich für Namensgebung auslesen
    lngAnzahl = WbkQ.Worksheets(2).UsedRange.Rows.Count
    strAnfang = Format(Sheets(2).Cells(2, 7), "DD_MM_YY")
    strEnde = Format(Sheets(2).Cells(lngAnzahl, 7), "DD_MM_YY")
    strName2 = WbkQ.Name
    strPfad = ActiveWorkbook.Path
    strName = strPfad & "\Auswertung Stahl E-Trak  " & strAnfang & " bis " & strEnde & ".xlsx"
    'Set WbkZ = Workbooks.Add(1)
    WbkQ.Save
    WbkQ.Worksheets(1).Delete
    WbkQ.SaveAs strName, FileFormat:=xlOpenXMLWorkbook
    
    'Set WbkZ = strPfad & strName2
    Workbooks.Open "E-Trak - Auswertungsmakro2.xlsm"
    WbkQ.Close
    
    'WbkQ.Activate
    'lngs = 2
    'lngAnzahl = WbkZ.Sheets.Count
    
    '
    'For Each obj In Application.Sheets
    '    If obj.Name <> "Makro" Then
    '        If obj.Type = xlWorksheet Then
    '            WbkQ.Sheets(lngs).Copy _
    '            After:=WbkZ.Sheets(lngAnzahl)
    '            lngs = lngs + 1
    '            lngAnzahl = lngAnzahl + 1
    '        Else
    '            WbkQ.Sheets(lngs).Copy _
    '            'WbkZ.Sheets(lngAnzahl).PastePicture
    '            WbkZ.Sheets.Add After:=WbkZ.Sheets(lngAnzahl - 1)
    '            WbkZ.Sheets(lngAnzahl).Paste (xlPasteValues)
    '            lngs = lngs + 1
    '            lngAnzahl = lngAnzahl + 1
    '        End If
    '    End If
    'Next obj
    
    
    
    
    ''***    Arbeitblätter in die neu erstellte Arbeitsmappe kopieren
    'For Each obj In Application.Sheets
    '    If obj.Name <> "Makro" Then
    '        If obj.Type = xlChart Then
    '            WbkQ.Sheets(lngs).CopyPicture _
    '            After:=WbkZ.Sheets(lngAnzahl)
    '            lngs = lngs + 1
    '            lngAnzahl = lngAnzahl + 1
    '        Else
    '            WbkQ.Sheets(lngs).Copy _
    '            After:=WbkZ.Sheets(lngAnzahl)
    '            lngs = lngs + 1
    '            lngAnzahl = lngAnzahl + 1
    '        End If
    '    End If
    'Next obj
    
    'Dim iCount As Integer
    'Dim iType As Integer
    'Dim sTemp As String
    'Dim oChart As Chart
    'Dim bFound As Boolean
    '
    'WbkQ.Activate
    'lngs = 2
    'lngAnzahl = WbkZ.Sheets.Count
    'For Each obj In Application.Sheets
    '    WbkQ.Activate
    '    If obj.Name <> "Makro" Then
    '        iType = Sheets(lngs).Type
    '        bFound = False
    '        For Each oChart In Charts
    '            If oChart.Name = Sheets(lngs).Name Then
    '                bFound = True
    '            End If
    '        Next oChart
    '        If bFound = True Then
    '            WbkQ.Sheets(lngs).CopyPicture _
    '            After:=WbkZ.Sheets(lngAnzahl)
    '            lngs = lngs + 1
    '            lngAnzahl = lngAnzahl + 1
    '        Else
    '            WbkQ.Sheets(lngs).Copy _
    '            After:=WbkZ.Sheets(lngAnzahl)
    '            lngs = lngs + 1
    '            lngAnzahl = lngAnzahl + 1
    '        End If
    '    End If
    'Next obj
    
    
    
    '***    Zieldatei speichern und schließen
    'WbkQ.Close savechanges:=True
    
    '***    Bildschirmaktualisierung wieder einschalten
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Die Datei " & strName & " wurde erfolgreich exportiert.", vbExclamation
        
    End Sub
    

    Edit: Hab deinen Code mal ausprobiert und er funktioniert einwandfrei, was der ist der Unterschied bei deinem Kopiervorgang zu meinen Kopier- bzw SaveAs-Vorgängen?
    Ist der entscheidene Unterschied, dass ich ganze Sheets kopiere und du diese in ein Array packst?


    Edit2: so sieht dann dein Code in mein Programm eingebunden aus, funktioniert alles super, vielen Dank!


    Code:
    Private Sub CommandButton3_Click()
    
    '***    Auswertung exportieren
    Dim strAnfang As String, strEnde As String, strPfad As String, strName As String
    Dim WbkQ As Workbook
    Dim lngAnzahl As Long
    Dim lngTabs As Long
    Dim lngZaehler As Long
    
    '***    Quell-Arbeitsblatt festlegen
    Set WbkQ = ThisWorkbook
    
    '***    Kontrolle, ob Auswertung vorhanden ist
    If WbkQ.Sheets.Count > "1" Then
    
    Else
    MsgBox "Keine Auswertung vorhanden!", vbCritical
    Exit Sub
    End If
    
    '***    Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    '***    Zeitbereich für Namensgebung auslesen
    lngAnzahl = WbkQ.Worksheets(2).UsedRange.Rows.Count
    strAnfang = Format(Sheets(2).Cells(2, 7), "DD_MM_YY")
    strEnde = Format(Sheets(2).Cells(lngAnzahl, 7), "DD_MM_YY")
    strPfad = ActiveWorkbook.Path
    strName = strPfad & "\Auswertung Stahl E-Trak  " & strAnfang & " bis " & strEnde & ".xlsx"
    
    lngZaehler = 1
    Dim arrTabellen()
    ReDim arrTabellen(1 To Sheets.Count - 1)
    For lngTabs = 1 To Sheets.Count
        If Sheets(lngTabs).Name <> "Makro" Then
            arrTabellen(lngZaehler) = lngTabs
            lngZaehler = lngZaehler + 1
        End If
    Next lngTabs
    Sheets(arrTabellen).Copy
    
    '***    Zieldatei speichern und schließen
    ActiveWorkbook.Close savechanges = True, Filename = strName
    
    '***    Bildschirmaktualisierung wieder einschalten
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Die Datei " & strName & " wurde erfolgreich exportiert.", vbExclamation
        
    End Sub
     
    Zuletzt bearbeitet: 5. Juli 2016
    Icebreak3r, 5. Juli 2016
    #5
  6. Beverly
    Beverly Erfahrener User
    Hi,

    mit meinem Code werden durch die Benutzung des Arrays die Arbeitsblätter, auf die sich die Diagramme beziehen, zusammen mit den Diagrammblättern als neue Arbeitsmappe erstellt und nicht einfach in eine neue (andere) Arbeitsmappe kopiert - das ist der Unterschied zu deinem Code. Dadurch bleibt der Bezug in den Diagrammen auf die neu erstellt Arbeitsmappe.

    Falls du mal Diagramme in eine andere Arbeitsmappe kopieren und ihre Bezüge auf die neue Mappe ändern willst, musst du einfach in einer Schleife über alle Diagramme und dort wiederum über alle Datenreihen laufen und in deren Datenreihenformel den Bezug zur Ausgangsarbeitsmappe löschen (einfach durch Nichts ersetzen).

    Bis später,
    Karin
     
    Beverly, 5. Juli 2016
    #6
  7. Icebreak3r Erfahrener User
    Eine letzte Sache noch: Ich dachte das passiert auch, wenn man die Datei unter einem anderen Namen abspeichert. War ein bisschen irritiert, als das nicht funktioniert hat.

    Vielen Dank nochmal für die Hilfe!
     
    Icebreak3r, 5. Juli 2016
    #7
  8. Beverly
    Beverly Erfahrener User

    xlSheetType bei Erstellen von Diagrammen per VBA

    Wenn du die Original-Arbeitsmappe mit den Diagrammen unter einem anderen Namen speicherst, dann sind die Diagrammbezüge selbstverständlich auf die neue Arbeitsmappe und nicht auf die Ausgangsmappe.

    Es gibt übrigens 2 Möglichkeiten zum Speichern: SaveAs (Speichern als) und SaveCopyAs (Kopie speichern als) - bei SaveAs wird die Originalmappe unter dem neuen Namen gespeichert (und die Ausgangsmappe "ist weg"), bei SaveCopyAs wird eine Kopie der Originalmappe unter dem neuen Namen gespeichert (und die Ausgangsmappe "bleibt da").

    Bis später,
    Karin
     
    Beverly, 5. Juli 2016
    #8
Thema:

xlSheetType bei Erstellen von Diagrammen per VBA

Die Seite wird geladen...
  1. xlSheetType bei Erstellen von Diagrammen per VBA - Similar Threads - xlSheetType Erstellen Diagrammen

  2. Automatisierung erstellen

    in Microsoft Outlook Hilfe
    Automatisierung erstellen: Hallo, wir haben folgendes Problem: Unserer Rechnungsprogram ist angeblich nicht individuell programmierbar und geht nur auf einen Kundenwunsch ein. Bei der Erstellung Rechnung-per Mail wird eine...
  3. Tabellenverzeichnis erstellen - individuelle Formatierung

    in Microsoft Word Hilfe
    Tabellenverzeichnis erstellen - individuelle Formatierung: Hallo zusammen, ich suche nach einer Möglichkeit, mein Tabellenverzeichnis individuell und damit unabhängig von der Formatierung des Abbildungsverzeichnisses zu formatieren. Ich habe das...
  4. Hilfe für Formel erstellen

    in Microsoft Excel Hilfe
    Hilfe für Formel erstellen: Ich möchte den Fremdwährungsbestand automatisieren. Das heisst den Bestand automatisch bewirtschaften. Zum Beispiel Wieviel Noten ich von einer Sorte bestellen muss, wenn Lagerbestand nur noch 10...
  5. Android Office Word mehrere Tabs erstellen

    in Microsoft Word Hilfe
    Android Office Word mehrere Tabs erstellen: Hallo, ich habe gerade Microsoft Office 365 Single auf meinem Android Tablet installiert und habe eine Frage zu Word. Bei der Desktopversion kann man ja mehrere Tabs nebeneinander oder zumindest...
  6. Daten aus anderer Mappe

    in Microsoft Excel Hilfe
    Daten aus anderer Mappe: Hallo zusammen, ich habe für die bessere Verständlichkeit eine Excel erstellt, die mein Problem beschreibt. In Tabelle 2 sind verschiede Formen dargestellt, denen mehrere Eigenschaften zugeordnet...
  7. Formel erstellen

    in Microsoft Excel Hilfe
    Formel erstellen: Hallo, ich bin neu auf diesen Seiten und habe folgende Frage: Zur Dokumentation möchte ich, das erstens in den Spalten der Zählerstand eingetragen wird aber nur die Differenz zum vorigen Monat...
  8. Unmittelbar nebeneinander liegende Gruppierungen erstellen.

    in Microsoft Excel Hilfe
    Unmittelbar nebeneinander liegende Gruppierungen erstellen.: Hallo liebe Excel-Experte, ich möchte gerne unmittelbar nebeneinander liegende Gruppierungen von Spalten erstellen. Das gelingt mir aber nicht. Ich muss immer eine nicht gruppierte Spalte...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden