Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
376to380
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
376to380
376to380
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Blatt per Makro ausschneiden und speichern?

Blatt per Makro ausschneiden und speichern?
05.02.2004 14:25:58
Markus H.
Moin,
habe mir dieses Makro zusammengebastelt:

Private Sub CommandButton4_Click() 'Neue Rg
Application.ScreenUpdating = False
If MsgBox("Möchten Sie eine Neue Rechnung erstellen?", vbYesNo, "Neue Rechnung?") = vbYes Then
Sheets("Rechnung").Copy After:=Sheets(1)
Sheets("Rechnung (2)").Name = "RGNR" & Range("H13")
Worksheets("RGNR" & Range("H13")).OLEObjects("CommandButton4").Delete
Worksheets("RGNR" & Range("H13")).OLEObjects("CommandButton2").Delete
Worksheets("RGNR" & Range("H13")).OLEObjects("CommandButton5").Delete
Worksheets("RGNR" & Range("H13")).OLEObjects("ListBox1").Delete
Datei = "RNR " & Range("B13")
ActiveSheet.SaveAs (Datei)
ActiveSheet.Delete
Sheets("Rechnung").Select
MsgBox ("gespeichert")
End If
Application.DisplayAlerts = True
End Sub


Von der Funktionsweise hatte ich mir das so vorgestellt:
Zuerst wird das ursprungsblatt ("Rechnung") kopiert, und eingefügt ("Rechnung(2)") dann wird dieses Blatt umbenannt in RGNR&Rechnung!H13 (was einer zahl entspricht)
Jetzt soll dieses Arbeitsblatt in einen neue Datei eingefügt werden, und dort sollen alle buttons gelöscht werden. und die Datei an eine bestimmte stelle gespeichert, und dann geschlossen werden. -> man soll dann zurück zur ursprungstabelle kommen udn dort soll eine MsgBox erscheinen die sagt, dass die datei gespeichert wurde!
ich weiß das viel in dem script falsch ist bzw. fehlt.
Hoffe ihr könnt mir helfen..
MfG
Markus

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

Betreff
Datum
Anwender
Anzeige
AW: Blatt per Makro ausschneiden und speichern?
05.02.2004 14:32:51
Josef Ehrensberger
Hallo Markus!
Wenn Du die Recherche bemühen würdest, findest
Du sicher einige Duzent Beiträge zu diesem Thema.
Z.B. hier
https://www.herber.de/forum/messages/376583.html
Schau Dir den Code an und versuch ihn an Deine Bedürfnisse
anzupassen. Bei Problemen hilft man Dir gerne weiter.
Gruß Sepp
hmm.. sicher..
05.02.2004 16:00:44
Markus H.
von der sache her hast du recht, nur wenn ein noob programmiert wird das irgendwann so unübersichtlich... aber so ist es besser, da ich viel mehr selber überlegen muss und mir sachen auch schneller merke..
ich hab das jetzt so gemacht:

Private Sub CommandButton4_Click() 'Neue Rg
Application.ScreenUpdating = False
If MsgBox("Möchten Sie eine Neue Rechnung erstellen?", vbYesNo, "Neue Rechnung?") = vbYes Then
Sheets("Rechnung").Copy After:=Sheets(1)
Sheets("Rechnung (2)").Name = "RGNR" & Range("H13")
ActiveSheet.Move
ActiveSheet.OLEObjects("CommandButton4").Delete
ActiveSheet.OLEObjects("CommandButton2").Delete
ActiveSheet.OLEObjects("CommandButton5").Delete
ActiveSheet.OLEObjects("ListBox1").Delete
ActiveWorkbook.SaveAs ("C:\Dokumente und Einstellungen\p_azubi\Desktop\" & "Rechnung # " & Range("H13") & "   vom   " & Format(Date, "dd mmm yyyy"))
ActiveWorkbook.Save
ActiveWorkbook.Close
Worksheets("Rechnung").Select
MsgBox "Rechnung # " & Range("H13") & "     wurde nach " & vbCr & ("C:\Dokumente und Einstellungen\p_\Desktop\") & vbCr & " gespeichert"
Range("A11:D18,A25:A43,B25:G43").Select
Selection.ClearContents
Range("B12").Select
Range("H13") = Range("H13") + 1
End If
Application.DisplayAlerts = True
End Sub


gibt es eine möglichkeit alle scripts aus einem kopierten arbeitsplatz zu nehmen?
die buttons hab ich ja schon rausgenommen, aber die scripts sind noch enthalten..
hoffe auf hilfe.. :-)
MfG
Markus
Anzeige
AW: hmm.. sicher..
05.02.2004 16:39:42
Josef Ehrensberger
Hallo Markus!
Schau Dir diesen Code an.
Ich hab's nicht getestet, weil ich zu faul bin mir die Tabelle
nachzubauen, müsste aber klappen.


Sub CommandButton4_Click()
Dim strPath As String
Dim strWert As String
Dim shp As Shape
If MsgBox("Möchten Sie eine Neue Rechnung erstellen?", vbYesNo, "Neue Rechnung?") = vbYes Then
strPath = "C:\Dokumente und Einstellungen\p_azubi\Desktop\"  'Pfad
strWert = ActiveSheet.Range("H13")   'Rechnungsnummer
Application.ScreenUpdating = False
ActiveSheet.Copy
With ActiveWorkbook
Sheets(1).Name = "RGNR" & strWert
For Each shp In Sheets(1).Shapes    'Schaltflächen entfernen
shp.Delete
Next
'VBA-Code entfernen
With .VBProject.VBComponents(.VBProject.VBComponents(2).CodeModule).CodeModule
    .DeleteLines 1, .CountOfLines
End With
.Sheets(1).Cells.Locked = True  'Zellen sperren
.Sheets(1).Protect "test"       'Blattschutz setzen - Passwort anpassen
.SaveAs strPath & "Rechnung # " & strWert & "   vom   " & _
Format(Date, "dd mmm yyyy") & ".xls"
.Close
End With
MsgBox "Rechnung # " & strWert & "     wurde nach " & vbCr & _
strPath & vbCr & " gespeichert"
Range("A11:D18,A25:A43,B25:G43").ClearContents
Range("B12").Select
Range("H13") = Range("H13") + 1
Application.ScreenUpdating = True
End If
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige