Makro zum Expotieren von Tabellenblatt

Kira_61d925 · 2. August 2008 um 17:21

Hallo,

ich habe folgendes Problem bei Excel 97.

Ich möchte ein Makro haben, welches ein Tabellenblatt in eine neue Arbeitsmappe kopiert. Das habe ich soweit noch geschafft. Jetzt soll das Makro aber gleichzeitig noch in der Neuen Arbeitsmappe ein Makro in „Diese Arbeitsmappe“ reinschreiben, so dass dieses bei öffnen der neuen Exceltabelle automatisch ausgeführt wird. Hierbei handelt es sich um ein Makro, welches bei geschützten Dateien die Gliederungen freischaltet, dieses Makro habe ich auch bereits schon. Mir fehlt also nur noch der Teil, in welchem das Makro in die neue Exceltabelle hineingschrieben wird.

Ich hoffe dies geht bei Excel 97 überhaupt.

Schon einmal jetzt vielen Dank für eure Hilfe.
Gruß Johannes.

drambeldier · 2. August 2008 um 18:51

Moin, Johannes,

leg eine leere Excel-Datei als Muster an, die nichts außer dem Startmakro enthält. Die kopierst Du bei Bedarf, und in die Kopie hinein kopierst Du dann das aktuelle Tabellenblatt.

Gruß Ralf

Kira_61d925 · 2. August 2008 um 22:40

Danke für die Antwort.

Das Problem dabei ist dass die Datei auf verschiedenen Rechner verwendet werden soll und die Datei die verschickt werden soll darf nur eine Datei sein.

Gruß Johannes.

Reinhard_fb8cb7 · 3. August 2008 um 00:21

Ich möchte ein Makro haben, welches ein Tabellenblatt in eine
neue Arbeitsmappe kopiert. Das habe ich soweit noch geschafft.
Jetzt soll das Makro aber gleichzeitig noch in der Neuen
Arbeitsmappe ein Makro in „Diese Arbeitsmappe“ reinschreiben,
so dass dieses bei öffnen der neuen Exceltabelle automatisch
ausgeführt wird. Hierbei handelt es sich um ein Makro, welches
bei geschützten Dateien die Gliederungen freischaltet, dieses
Makro habe ich auch bereits schon. Mir fehlt also nur noch der
Teil, in welchem das Makro in die neue Exceltabelle
hineingschrieben wird.
Ich hoffe dies geht bei Excel 97 überhaupt.

Hi Johannes,

poste mal den Code der in „Diese Arbeitsmappe“ der neuen Datei eingefügt werden soll.
Und auch den Code der die neue Mappe erzeugt.

Besondere Schwierigkeiten wegen XL97 sehe ich nicht.

Gruß
Reinhard

drambeldier · 3. August 2008 um 10:05

Moin, Johannes,

Das Problem dabei ist dass die Datei auf verschiedenen Rechner
verwendet werden soll

und? Eine Musterdatei enthält einen Makro, Du befüllst eine Kopie mit Daten und verschickst diese, so oft Du magst.

und die Datei die verschickt werden soll
darf nur eine Datei sein.

Du wirst wohl oder übel so viele Dateien haben wie Rechner, auf die das Original verschickt wurde.

Gruß Ralf

Kira_61d925 · 4. August 2008 um 20:52

Hi Johannes,

poste mal den Code der in „Diese Arbeitsmappe“ der neuen Datei
eingefügt werden soll.
Und auch den Code der die neue Mappe erzeugt.

Besondere Schwierigkeiten wegen XL97 sehe ich nicht.

Gruß
Reinhard

Hallo Reinhard,

Sorry dass ich erst heute antworte, werde den Code morgen erst posten können und das Gesamte Problem noch einmal detaillierter Beschreiben.

Gruß Johannes.

Kira_61d925 · 6. August 2008 um 09:28

Servus,

also hier noch einmal das genaue Problem mit den Makros:

Also ich habe eine datei mit 30 Tabellenblätter für 30 Anlagen, diese Tabellenblätter sollen jetzt exportiert werden. Dazu habe ich folgendes Makro erstellt:

Sub Pos01_Export()

’ 33 Änderungen

Sheets(„Pos.01“).Select
Sheets(„Pos.01“).Copy

Application.ScreenUpdating = False

ActiveSheet.Unprotect

Range(„D1“).Select
Selection.NumberFormat = „@“

’ !!! Bei anderen Makros sind die haben die Buttons andere Bezeichnungen !!!
ActiveSheet.Shapes(„Button 6“).Select
Selection.Cut
ActiveSheet.Shapes(„Button 7“).Select
Selection.Cut
ActiveSheet.Shapes(„Button 1“).Select
Selection.Cut
ActiveSheet.Shapes(„Button 9“).Select
Selection.Cut

Range(„G1“).Select
ActiveCell.FormulaR1C1 = „=RC[-3]“
Sheets(„Pos.01“).Range(„D1“).Value = Sheets(„Pos.01“).Range(„G1“).Value
Range(„G1“).Select
Selection.ClearContents

Range(„G2“).Select
ActiveCell.FormulaR1C1 = „=RC[-2]“
Sheets(„Pos.01“).Range(„E2“).Value = Sheets(„Pos.01“).Range(„G2“).Value
Range(„G2“).Select
Selection.ClearContents

Range(„G3“).Select
ActiveCell.FormulaR1C1 = „=RC[-2]“
Sheets(„Pos.01“).Range(„E3“).Value = Sheets(„Pos.01“).Range(„G3“).Value
Range(„G3“).Select
Selection.ClearContents

Range(„O8“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-8])“
Sheets(„Pos.01“).Range(„G8“).Value = Sheets(„Pos.01“).Range(„O8“).Value
Range(„O8“).Select
Selection.ClearContents
Range(„O9“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-8])“
Sheets(„Pos.01“).Range(„G9“).Value = Sheets(„Pos.01“).Range(„O9“).Value
Range(„O9“).Select
Selection.ClearContents
Range(„O10“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-8])“
Sheets(„Pos.01“).Range(„G10“).Value = Sheets(„Pos.01“).Range(„O10“).Value
Range(„O10“).Select
Selection.ClearContents
Range(„O11“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-8])“
Sheets(„Pos.01“).Range(„G11“).Value = Sheets(„Pos.01“).Range(„O11“).Value
Range(„O11“).Select
Selection.ClearContents

Range(„P8“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-7])“
Sheets(„Pos.01“).Range(„i8“).Value = Sheets(„Pos.01“).Range(„P8“).Value
Range(„P8“).Select
Selection.ClearContents
Range(„P9“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-7])“
Sheets(„Pos.01“).Range(„i9“).Value = Sheets(„Pos.01“).Range(„P9“).Value
Range(„P9“).Select
Selection.ClearContents
Range(„P10“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-7])“
Sheets(„Pos.01“).Range(„i10“).Value = Sheets(„Pos.01“).Range(„P10“).Value
Range(„P10“).Select
Selection.ClearContents
Range(„P11“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-7])“
Sheets(„Pos.01“).Range(„i11“).Value = Sheets(„Pos.01“).Range(„P11“).Value
Range(„P11“).Select
Selection.ClearContents

Range(„Q8“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-3])“
Sheets(„Pos.01“).Range(„N8“).Value = Sheets(„Pos.01“).Range(„Q8“).Value
Range(„Q8“).Select
Selection.ClearContents
Range(„Q9“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-3])“
Sheets(„Pos.01“).Range(„N9“).Value = Sheets(„Pos.01“).Range(„Q9“).Value
Range(„Q9“).Select
Selection.ClearContents
Range(„Q10“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-3])“
Sheets(„Pos.01“).Range(„N10“).Value = Sheets(„Pos.01“).Range(„Q10“).Value
Range(„Q10“).Select
Selection.ClearContents
Range(„Q11“).Select
ActiveCell.FormulaR1C1 = „=VALUE(RC[-3])“
Sheets(„Pos.01“).Range(„N11“).Value = Sheets(„Pos.01“).Range(„Q11“).Value
Range(„Q11“).Select
Selection.ClearContents

Range(„D1“).Select
Selection.NumberFormat = „General“

Range(„A1“).Select

Application.ScreenUpdating = True

ActiveSheet.Protect Password:=„XXXX“, DrawingObjects:=True, Contents:=True, Scenarios:=True
For Each Blatt In Worksheets
Blatt.Protect UserInterfaceOnly:=True
Blatt.EnableOutlining = True
Blatt.EnableAutoFilter = True
Next

Dim Neuer_Dateiname
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=„Pos01.xls“, fileFilter:=„Excel-Arbeitsmappe, *.xls“)
'If Neuer_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs FileName:=Neuer_Dateiname
End Sub

Diese Makro gibt es für jedes Tabellenblatt.

Da nach dem abspeichern und schließen der exportierten Datei, beim wieder öffnen der Schutz automatisch aktiv ist, was auch so bleiben soll, kann ich die Gliederungen nicht öffnen, was jedoch unbedingt nötig ist. Jetzt brauche ich ein Makro, welches beim Exportieren der Datei folgendes Makro in „Diese Arbeitsmappe“ schreibt:

Sub Workbook_Open()

Application.ScreenUpdating = False
For Each Blatt In Worksheets
Blatt.Protect „XXXX“, UserInterfaceOnly:=True
Blatt.EnableOutlining = True
Blatt.EnableAutoFilter = True
Next

End Sub

Ich will nur diese eine Basis-Datei haben, da diese an mehrer Leute geht, die an verschiedenen Rechnern arbeite.
Ich hoffe, dass es machbar ist.

Vielen Dank.

Gruß Johannes

Reinhard_fb8cb7 · 6. August 2008 um 11:37

Hi Johannes,

Also ich habe eine datei mit 30 Tabellenblätter für 30
Anlagen, diese Tabellenblätter sollen jetzt exportiert werden.
Dazu habe ich folgendes Makro erstellt:

Diese Makro gibt es für jedes Tabellenblatt.

warum das, warum nicht ein Makro für alle 30 Blätter, ähnlichen Aufbau vorausgesetzt.

Nachfolgend habe ich deinen Code bis zu den Sternchen bearbeitet, macht er das Gleiche wie dein Code, dann ändere den Rest nach dem Muster von O8-O11 ab.

Gibt es immer 4 Buttons pro Blatt?

Dim immer ma Anfang des Codes.

Zuanfangs des Moduls immer Option Explicit

Da nach dem abspeichern und schließen der exportierten Datei,
beim wieder öffnen der Schutz automatisch aktiv ist, was auch
so bleiben soll, kann ich die Gliederungen nicht öffnen, was
jedoch unbedingt nötig ist. Jetzt brauche ich ein Makro,
welches beim Exportieren der Datei folgendes Makro in „Diese
Arbeitsmappe“ schreibt:

Probier mal dies:

Sub Ereignis()
Dim Zei As Long
With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule
 Zei = .CreateEventProc("Open", "Workbook")
 .InsertLines Zei + 1, "Dim Blatt As Worksheet"
 .InsertLines Zei + 2, "Application.ScreenUpdating = False"
 .InsertLines Zei + 3, "For Each Blatt In Worksheets"
 .InsertLines Zei + 4, " Blatt.Protect ""XXXX"", UserInterfaceOnly:=True"
 .InsertLines Zei + 5, " Blatt.EnableOutlining = True"
 .InsertLines Zei + 6, " Blatt.EnableAutoFilter = True"
 .InsertLines Zei + 7, "Next"
 .InsertLines Zei + 8, "Application.ScreenUpdating = True"
End With
End Sub

Alle Codes sind ungetestet.

Gruß
Reinhard

Option Explicit
'
Sub Pos01\_Export()
Dim awf As WorksheetFunction
Dim Neuer\_Dateiname, Blatt
Set awf = Application.WorksheetFunction
' 33 Änderungen
Worksheets("Pos.01").Copy
Application.ScreenUpdating = False
With AtiveSheet
 .Unprotect
 .Range("D1").NumberFormat = "@"
 ' !!! Bei anderen Makros sind die haben die Buttons andere Bezeichnungen !!!
 .Shapes("Button 6").Delete
 .Shapes("Button 7").Delete
 .Shapes("Button 1").Delete
 .Shapes("Button 9").Delete

 .Range("D1").Value = awf.Value(.Range("G1").Offset(0, -3).Value)
 .Range("D1").Value = awf.Value(.Range("G2").Offset(0, -2).Value)
 .Range("E3").Value = awf.Value(.Range("G3").Offset(0, -2).Value)

 .Range("G8").Value = awf.Value(.Range("O8").Offset(0, -8).Value)
 .Range("G9").Value = awf.Value(.Range("O9").Offset(0, -8).Value)
 .Range("G10").Value = awf.Value(.Range("O10").Offset(0, -8).Value)
 .Range("G11").Value = awf.Value(.Range("O11").Offset(0, -8).Value)
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
 .Range("P8").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-7])"
 .Range("i8").Value = .Range("P8").Value
 .Range("P8").Select
 Selection.ClearContents
 .Range("P9").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-7])"
 .Range("i9").Value = .Range("P9").Value
 .Range("P9").Select
 Selection.ClearContents
 .Range("P10").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-7])"
 .Range("i10").Value = .Range("P10").Value
 .Range("P10").Select
 Selection.ClearContents
 .Range("P11").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-7])"
 .Range("i11").Value = .Range("P11").Value
 .Range("P11").Select
 Selection.ClearContents

 .Range("Q8").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-3])"
 .Range("N8").Value = .Range("Q8").Value
 .Range("Q8").Select
 Selection.ClearContents
 .Range("Q9").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-3])"
 .Range("N9").Value = .Range("Q9").Value
 .Range("Q9").Select
 Selection.ClearContents
 .Range("Q10").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-3])"
 .Range("N10").Value = .Range("Q10").Value
 .Range("Q10").Select
 Selection.ClearContents
 .Range("Q11").Select
 ActiveCell.FormulaR1C1 = "=VALUE(RC[-3])"
 .Range("N11").Value = .Range("Q11").Value
 .Range("Q11").Select
 Selection.ClearContents
 .Range("D1").Select
 Selection.NumberFormat = "General"
 .Range("A1").Select
End With
Application.ScreenUpdating = True
.Protect Password:="XXXX", DrawingObjects:=True, Contents:=True, Scenarios:=True
For Each Blatt In Worksheets
 Blatt.Protect UserInterfaceOnly:=True
 Blatt.EnableOutlining = True
 Blatt.EnableAutoFilter = True
Next
Neuer\_Dateiname = Application.GetSaveAsFilename(InitialFileName:="Pos01.xls", fileFilter:="Excel-Arbeitsmappe, \*.xls")
'If Neuer\_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Neuer\_Dateiname
End Sub

Kira_61d925 · 6. August 2008 um 12:54

Hallo Reinhard,

des Makro funktioniert wie gewollt.

Probier mal dies:

Sub Ereignis()
Dim Zei As Long
With
ActiveWorkbook.VBProject.VBComponents(„DieseArbeitsmappe“).CodeModule
Zei = .CreateEventProc(„Open“, „Workbook“)
.InsertLines Zei + 1, „Dim Blatt As Worksheet“
.InsertLines Zei + 2, „Application.ScreenUpdating = False“
.InsertLines Zei + 3, „For Each Blatt In Worksheets“
.InsertLines Zei + 4, " Blatt.Protect „„XXXX““,
UserInterfaceOnly:=True"
.InsertLines Zei + 5, " Blatt.EnableOutlining = True"
.InsertLines Zei + 6, " Blatt.EnableAutoFilter = True"
.InsertLines Zei + 7, „Next“
.InsertLines Zei + 8, „Application.ScreenUpdating = True“
End With
End Sub

Des andere große Makro kann ich nicht so ändern, da die Zellen- und Buttonbezüge nicht bei allen Tabellen gleich sind und außerdem funktionieren die gerade so schön perfekt.

Aber des Problem, welche ich hatte hast du perfekt gelöst … ich bin soooo glücklich, dass ich endlich eine Lösung habe.

Gruß Johannes (kira).

Kira_61d925 · 6. August 2008 um 13:05

Hallo Reinhard,

eine kleinigkeit gibt es noch er schließt das Microsoft Visual Basic Fenster nicht nachdem er das Makro reingeschrieben hat, kann man dies noch in das Makro einbauen?

Gruß Johannes.

Reinhard_fb8cb7 · 6. August 2008 um 16:37

VB Editor per Vba beenden

eine kleinigkeit gibt es noch er schließt das Microsoft Visual
Basic Fenster nicht nachdem er das Makro reingeschrieben hat,
kann man dies noch in das Makro einbauen?

Hi Johannes,

bau das mal ein:

Application.VBE.MainWindow.Visible = False

Gruß
Reinhard

Kira_61d925 · 7. August 2008 um 07:54

Hallo Reinhard,

noch einmal vielen Dank für deine Hilfe bei meinem Problem.

Ich poste mal noch den kompletten Code falls jemand anderes das gleiche Problem wie ich hat:

Sub Outlining()
Application.ScreenUpdating = False
Dim Zei As Long
With ActiveWorkbook.VBProject.VBComponents(„DieseArbeitsmappe“).CodeModule
Zei = .CreateEventProc(„Open“, „Workbook“)
.InsertLines Zei + 1, „Dim Blatt As Worksheet“
.InsertLines Zei + 2, „Application.ScreenUpdating = False“
.InsertLines Zei + 3, „For Each Blatt In Worksheets“
.InsertLines Zei + 4, " Blatt.Protect „„XXXX““, UserInterfaceOnly:=True"
.InsertLines Zei + 5, " Blatt.EnableOutlining = True"
.InsertLines Zei + 6, " Blatt.EnableAutoFilter = True"
.InsertLines Zei + 7, „Next“
.InsertLines Zei + 8, „Application.ScreenUpdating = True“
Application.VBE.MainWindow.Visible = False
Application.ScreenUpdating = True

End With
End Sub

Gruß Johannes (kira)