Supportnet / Forum / Tabellenkalkulation

Hallo Liebe Excel-Spezies! Ich habe folgendes Makro auf einer Seite gefunden und für mich zurechtgestutzt. Funktioniert bei mir auch ganz gut. Nun habe ich jedoch noch folgende Probleme. 1. Ich möchte die vorhandenen Verknüpfungen gelöscht haben. 2. Da ich die Datei weitergebe, ändert sich natürlich auch der Pfad. Um nicht in allen (12) Dateien den Pfad ändern zu müssen, wäre ein Makro gut, dass alle offenen Dateien, bis auf die Ausführungsdatei in einen vorgegebenen Ornder abspeichert . Perfekt wäre, wenn noch der Zusatz aus einer Zelle der Ausführungsdatei an den Dateinamen angehängt werden könnte. Basis ist dieses Makro! Sub Datei_speichern() Dim Verzeichnis, Ordnername, Pfad Set Verzeichnis = CreateObject("Scripting.FileSystemObject") Pfad = "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\EIGENE DINGE !!!\Kunsthalle\Module und Auswertungen\Auswertungen 2005" Ordnername = Pfad & Range("G3") If Verzeichnis.FolderExists(Ordnername) = False Or Range("G3") = " " Then MkDir Pfad & Range("G3") Else MsgBox "Sie haben keinen Ordnernamen in Zelle G3 angegeben. Bitte holen Sie diese Eingabe nach.", vbCritical, "Fehler" Exit Sub End If ActiveWorkbook.SaveAs Filename:=Pfad & Range("G3") & "\" & ActiveWorkbook.Name End Sub Vielen Dank für die Hilfe im Voraus!!!

Hallooooo!
Hat denn niemand eine gute Idee???
Gruss
Ines

Hi Ines,

ich kann Dir leider nur einen Teile Deiner Frage beantworten und zwar nur den Teil 2. Teil 1 kann ich nicht beantworten, da ich nicht weiß, was Du mit


meinst.

Zu Frage 2 sähe das Makro folgendermaßen aus:

Sub Datei_speichern()
Dim Verzeichnis, Ordnername, Pfad
Set Verzeichnis = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\EIGENE DINGE !!!\Kunsthalle\Module und Auswertungen\Auswertungen 2005"
Ordnername = Pfad & Range("G3")
If Verzeichnis.FolderExists(Ordnername) = False Then ´Or Range("G3") = "" Then
MkDir Pfad & Range("G3")
Else
MsgBox "Sie haben keinen Ordnernamen in Zelle G3 angegeben. Bitte holen Sie diese Eingabe nach.", vbCritical, "Fehler"
Exit Sub
End If
For Wiederholungen = 1 To Workbooks.Count
If Workbooks(Wiederholungen).Name <> "Ausführungsdatei.xls" Then
Workbooks(Wiederholungen).SaveAs Filename:=Pfad & Range("G3") & "\" & _
Mid(Workbooks(Wiederholungen).Name, 1, Len(Workbooks(Wiederholungen).Name) - 4) & "_" & Range("A1") & ".xls"
End If
Next
End Sub

Das Makro speichert Dir alle offenen Dateien bis auf die Datei „Ausführungsdatei.xls“. Anstelle „Ausführungsdatei.xls“ musst Du natürlich in dem Makro den Dateinamen Deiner Datei, die nicht abgespeichert werden soll, abändern. Der Speichername für die Dateien, die abgespeichert werden setzt sich aus dem ihrem alten Namen und zusätzlich dem Eintrag aus Zelle A1. Beispiel: Alter Name = Mappe.xls, Eintrag in Zelle A1 = 14.11.2005, Neuer Name = Mappe1_14.11.2005.xls

Ich hoffe, Du kommst klar. Bei Fragen melde Dich. Dann beschreibe auch mal näher was es mit den Verknüpfungen auf sich hat.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver!
Danke für Deine Lösung, werde ich gleich mal ausprobieren!
Mit Verknüpfungen meine ich, das meine abzuspeichernden Dateien Formel haben, die mit anderen Dateien verknüpft sind. Wenn ich diese aufheben will, kann man über "Bearbeiten" --> "Verknüpfungen löschen" alles in feste Werte umwandeln.
Ich habe mich jetzt hoffentlich klarer ausgedrückt.

Gruss
Ines

Hi Ines,

jetzt habe ich verstanden. Mit nachfolgendem Code werden Dir alle Verknüpfungen aller in der Datei befindlichen Tabellenblätter gelöscht.

Option Explicit

Sub Verknüpfungen_löschen()
Dim Wiederholungen As Integer
Application.ScreenUpdating = False
For Wiederholungen = 1 To Worksheets.Count
Sheets(Wiederholungen).Activate
Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets(Wiederholungen).Range("A1").Select
Next
End Sub

Jetzt mag der ein oder andere sagen, dass es auch mit dem Befehl

ActiveWorkbook.BreakLink Name:="Hier Pfad und Dateiname", Type:=xlExcelLinks

auch geht, allerdings hat dieser Befehl den Nachteil, dass immer der Pfad und der Dateiname angepasst werden muss. Bei obigem Makro ist das egal.

Eventuell hilft es Dir ja. Entweder der obige Code oder der untere Befehl.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hi Oliver!
Das Makro hakt leider! Die Meldung lautet "Kompilierungsfehler"!

...
If Verzeichnis.FolderExists(Ordnername) = False Then ´Or Range("G3") = "" Then
MkDir Pfad & Range("G3")
Else
...

Was bedeutet überhaupt kompilieren?

Gruss
Ines

......(mind. 6 zeichen)

Hi Ines,

der Fehler lag bei mir. Ich hatte da was zum testen auskommentiert und vergessen das wieder Rückgängig zu machen. Nachfolgend das Makro wie es funktionieren sollte.

Sub Datei_speichern()
Dim Verzeichnis, Ordnername, Pfad
Set Verzeichnis = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\EIGENE DINGE !!!\Kunsthalle\Module und Auswertungen\Auswertungen 2005"
Ordnername = Pfad & Range("G3")
If Verzeichnis.FolderExists(Ordnername) = False Or Range("G3") = " " Then
MkDir Pfad & Range("G3")
Else
MsgBox "Sie haben keinen Ordnernamen in Zelle G3 angegeben. Bitte holen Sie diese Eingabe nach.", vbCritical, "Fehler"
Exit Sub
End If
For Wiederholungen = 1 To Workbooks.Count
If Workbooks(Wiederholungen).Name <> "Ausführungsdatei.xls" Then
Workbooks(Wiederholungen).SaveAs Filename:=Pfad & Range("G3") & "\" & _
Mid(Workbooks(Wiederholungen).Name, 1, Len(Workbooks(Wiederholungen).Name) - 4) & "_" & Range("A1") & ".xls"
End If
Next
End Sub

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver!
Ich habe die Zellen noch verändert, damit es bei mir passt.
Wenn der anzulegende Ordner bereits vorhanden ist, geht das Makro nicht, sagt ich hätte keinen Ordner angegeben! Das ist nicht so günstig, vielleicht aber nicht zu ändern.
Problematisch ist jedoch noch, das die Ausführungsdatei (mein Modul 1) mit abgespeichert wird. Das soll jedoch gerade nicht.

Die Sache mit den Verknüpfungen habe ich nicht kapiert.
Hast Du da auch noch eine Einbaulösung als Gesamt-Makro???

Sub Dateien_speichern()
Dim Verzeichnis, Ordnername, Pfad
Set Verzeichnis = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\EIGENE DINGE !!!\Kunsthalle\Module und Auswertungen\Auswertungen 2005\"
Ordnername = Pfad & Range("J1")
If Verzeichnis.FolderExists(Ordnername) = False Or Range("J1") = " " Then
MkDir Pfad & Range("J1")
Else
MsgBox "Sie haben keinen Ordnernamen in Zelle J1 angegeben. Bitte holen Sie diese Eingabe nach.", vbCritical, "Fehler"
Exit Sub
End If
For Wiederholungen = 1 To Workbooks.Count
If Workbooks(Wiederholungen).Name <> "Modul 1.xls" Then
Workbooks(Wiederholungen).SaveAs Filename:=Pfad & Range("J1") & "\" & _
Mid(Workbooks(Wiederholungen).Name, 1, Len(Workbooks(Wiederholungen).Name) - 4) & "_" & Range("I1") & ".xls"
End If
Next
End Sub

Ich weiß, ich nerve langsam, aber was soll ich machen :-)
Gruss
Ines

Hallo Ines,

unabhängig, dass das von mir gepostete Makro bei mir unter Excel 2002 und Excel 2003 ohne Fehler gelaufen ist, wundert es mich doch sehr, dass an der Stelle, die Du hier aufführst, ein Fehler auftritt, da ich an dem Teil des Makros überhaupt nichts geändert habe. Der Teil ist noch genau so, wie in Deiner 1. Frage. Da muss es aber doch gelaufen haben, jedenfalls hast Du geschrieben,



und das ist für mich unmissverständlich, dass es bei Dir läuft.

Nachfolgend ein Makro, dass auch bei Dir laufen sollte. Tausche es gegen das alte aus.

Option Explicit

Sub Dateien_speichern()
Dim Verzeichnis, Ordnername, Pfad, Wiederholungen As Integer, Actives_Blatt As String
Application.ScreenUpdating = False
Actives_Blatt = ActiveSheet.Name
Set Verzeichnis = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\EIGENE DINGE !!!\Kunsthalle\Module und Auswertungen\Auswertungen 2005"
Ordnername = Pfad & Range("J1")
If Not IsEmpty(Range("J1")) Then
If Verzeichnis.FolderExists(Ordnername) = False Then
MkDir Ordnername
End If
Else
MsgBox "Sie haben keinen Ordnernamen in Zelle J1 angegeben. Bitte holen Sie diese Eingabe nach.", vbCritical, "Fehler"
Exit Sub
End If
For Wiederholungen = 1 To Workbooks.Count
If Workbooks(Wiederholungen).Name <> "Modul 1.xls" Then
Workbooks(Wiederholungen).SaveAs Filename:=Ordnername & "\" & _
Mid(Workbooks(Wiederholungen).Name, 1, Len(Workbooks(Wiederholungen).Name) - 4) & "_" & Range("A1") & ".xls"
End If
Next
For Wiederholungen = 1 To Worksheets.Count
Sheets(Wiederholungen).Activate
Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets(Wiederholungen).Range("A1").Select
Next
Sheets(Actives_Blatt).Activate
End Sub

Dass bei Dir auch die Datei Modul 1.xls mit abgespeichert wird, kann nur daran liegen, dass die die Datei nicht unter dem Namen abgespeichert ist. Also überprüfe den Namen noch mal genaustens. Ansonsten werden Dir alle Dateien, die geöffnet sind unter ihrem Namen abgespeichert. Bedingung ist allerdings, dass die Dateien, die geöffnet sind schon mal abgespeichert wurden. Wenn dem nicht so ist muss das Makro noch mal umgestellt werden. Aber eventuell ist das nicht notwendig, deshalb erspare ich mir die Arbeit erst mal.

Ich hoffe, es funktioniert bei Dir jetzt auch.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver!
Der erste Tei funktioniert jetzt auch bei mir, nur mit dem folgenden blockiert es. Ich verstehe auch überhaupt nicht, was damit bezweckt werden soll.
Wenn ich das aufzeichne, was passieren soll, sieht das ganz anders aus! Nämlich so:

Sub Verknüpfungen_löschen()

    Windows("Unternehmensauswertung Kosten.XLS").Activate
    ´geöffnete und zu speichernde Datei
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Deckblatt").Select
    ActiveWorkbook.BreakLink Name:= _
        "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\Kunsthalle\Module und Auswertungen\0. Auswertungs-Module\5. Plan Jahres Auswertung\Modul 1.XLS" _
        , Type:=xlExcelLinks
    ChDir _
        "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\Kunsthalle\Module und Auswertungen"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\Kunsthalle\Module und Auswertungen\Unternehmensauswertung Kosten.XLS" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Range("B1:G1").Select
End Sub

Dein Code hackt...

...
For Wiederholungen = 1 To Worksheets.Count
Sheets(Wiederholungen).Activate
Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

´Hier!!!

Sheets(Wiederholungen).Range("A1").Select
Next
Sheets(Actives_Blatt).Activate
End Sub 

Vielleicht schreiben wir ja noch immer aneinander vorbei???
Lieben Gruss
INES

Hallo Ines,

das mein Code und Dein aufgezeichneter Code nicht identisch aussehen können ist klar. Der Code den Du aufzeichnest ist um ein vielfaches zu lang und zu umständlich. Daher benutze ich keinen Aufgezeichneten, sondern schreibe einen selber. Deshalb können beide nicht identisch aussehen. Außerdem kann man dass was Du erreichen möchtest nicht mit dem Makrorekorder aufzeichnen.

Was hakt den an dem Makro von mir? Mit der Zeile "Hier!!!" kann ich nichts anfangen. Kommt dort ein Laufzeitfehler? Wenn ja, welcher Luafzeitfehler erscheint? Welche Zeile wird gelb markiert?

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver!
Das mit dem Unterschied zur Aufzeichnung ist mir schon klar, aber was will denn das Ende des Makros bewirken???
Vielleicht kannst Du das zeilenweise einmal beschreiben.
Kopierst Du alle Mappeninhalte als Werte in eine neue Datei???

Sub Dateien_speichern()
Dim Verzeichnis, Ordnername, Pfad, Wiederholungen As Integer, Actives_Blatt As String
Application.ScreenUpdating = False
Actives_Blatt = ActiveSheet.Name
Set Verzeichnis = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\Dokumente und Einstellungen\Ines Heykes\Eigene Dateien\Kunsthalle\Module und Auswertungen\3. Auswertung Plan 2006"
Ordnername = Pfad & Range("J1")
If Not IsEmpty(Range("J1")) Then
If Verzeichnis.FolderExists(Ordnername) = False Then
MkDir Ordnername
End If
Else
MsgBox "Sie haben keinen Ordnernamen in Zelle J1 angegeben. Bitte holen Sie diese Eingabe nach.", vbCritical, "Fehler"
Exit Sub
End If
For Wiederholungen = 1 To Workbooks.Count
If Workbooks(Wiederholungen).Name <> "Modul 1.xls" Then
Workbooks(Wiederholungen).SaveAs Filename:=Ordnername & "\" & _
Mid(Workbooks(Wiederholungen).Name, 1, Len(Workbooks(Wiederholungen).Name) - 4) & " " & Range("I1") & ".xls"
                                                                                        ´Zelle der zusätzlichen Namensgebung
End If
Next
For Wiederholungen = 1 To Worksheets.Count
Sheets(Wiederholungen).Activate
Sheets(Wiederholungen).Cells.Copy

gelbe Zeile!!!
Sheets(Wiederholungen).Range("I1").PasteSpecial Paste:=xlPasteValues

Meine Fehlermeldung!
Laufzeitfehler 1004
Die Informationen können nicht eingefügt werden, da der Bereich Kopieren und der Bereich zum Einfügen unterschiedliche Formen und Größen haben. Versuchen Sie folgendes:
• Makieren Sie eine einzeln Zelle und wählen Sie dann „Einfügen“
• Makieren Sie einen Bereich, der die selbe Größe und Form hat und wählen sie dann „Einfügen“.

Application.CutCopyMode = False
Sheets(Wiederholungen).Range("I1").Select
Next
Sheets(Actives_Blatt).Activate
End Sub

Ich musste leider noch mal an dem Pfad was ändern, aber daran kann es ja eigentlich nicht liegen oder?

INES

Nabend Ines,

kann es sein, dass sich in einem Deiner Tabellenblätter "Verbundene Zellen" befinden?

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hi Oliver!
Jaaaaa! Und nun?

Der Ordner der angelegt wird, wo auch alles abgespeichert wird, die Dateien sind dann trotzt des Makro-Abbruchs alle da, sieht dann so aus:

3. Auswertung Plan 20063. Auswertung Plan 2006

Doppeltgemoppelt! Warum?

Nur die Verknüpfungen sind dann eben noch vorhanden.

MfG
Ines

Hi Ines,

das Anlegen, bzw. Speichern der Dateien passiert vor dem Löschen der Verknüpfungen. Deshalb befinden sich in dem Ordner bereits die abgespeicherten Dateien.

Das mit den verbundenen Zelle ist allerdings ein Problem. Denn VBA kann damit nicht umgehen. Müssen die verbundenen Zellen bleiben oder kannst Du die entfernen. Denn sonst würde es nur mit dem 2. Befehl aus meiner Antwort 4 gehen. Problem dabei ist nur, wenn in den Verknüpfungen mehrere verschiedene Dateinamen vorkommen, wird das auch nicht funktionieren.

Kannst Du mir die Datei mal schicken? Dann würde ich mir das mal ansehen. Die E-Mailadresse findest Du auf meiner HP u. A. im Impressum.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver!
Was macht mein Makro-Problem! Bist Du damit schon weitergekommen. Die Dateien hatte ich Dir doch geschickt?!
Ich hoffe Du hast trotzt des nahenden Weihnachtsfestes noch Zeit dafür!
Lieben Gruss
Ines

• Wie kann ich aus video_ts - dateien ein einzelnes Bild auschneiden und als jpg abspeichern?
• PC Datum per VBA Makro verändern