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

Schaltflächen und VBA Codes nicht mit Kopieren

Schaltflächen und VBA Codes nicht mit Kopieren
06.09.2004 11:30:11
Alex
Hi Liebe Excelfans,
habe folgenden Code um die ein Blatt zu kopieren und in einem bestimmten verzeichnis mit meinen angaben zu speichern.

Sub speich_unter()
Workbooks(1).Sheets(1).Copy
ChDir "R:\T2\T2S\T2S-Personaldaten\T2S-Statistik"
a = InputBox("Speichernamen" & Chr$(13) & Chr$(10) & Chr$(10) & _
"04 (JAHR) 10 (Monat)" & Chr$(13) & Chr$(10) & Chr$(10) & "Jahr und Monat in Ziffern" _
& Chr$(13) & Chr$(10) & Chr$(10) & "Speicherort R:\T2\T2S\T2S-Personaldaten\T2S-Statistik" _
, "Name eingeben", "")
ActiveWorkbook.SaveAs Filename:=a, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveSheet.Unprotect
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Das Problem ist das er mir die schaltflächen mit kopiert womit ich das speichen auslöse. Kann man den Code so ändern das er die schaltflächen nicht mit kpiert ?
Vielen Dank für Eure hilfe im vorraus
Gruß Alex

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schaltflächen und VBA Codes nicht mit Kopieren
Bert

Sub speich_unter()
Workbooks(1).Sheets(1).Copy
ChDir "R:\T2\T2S\T2S-Personaldaten\T2S-Statistik"
a = InputBox("Speichernamen" & Chr$(13) & Chr$(10) & Chr$(10) & _
"04 (JAHR) 10 (Monat)" & Chr$(13) & Chr$(10) & Chr$(10) & "Jahr und Monat in Ziffern" _
& Chr$(13) & Chr$(10) & Chr$(10) & "Speicherort R:\T2\T2S\T2S-Personaldaten\T2S-Statistik" _
, "Name eingeben", "")
ActiveWorkbook.SaveAs Filename:=a, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveSheet.Unprotect
ActiveSheet.DrawingObjects.delete
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Bert
Anzeige
Klappt Super. DANKE. o.T.
Alex
Vielen Dank Bert klappt super.
Gruß Alex o.T
Sorry Bert noch eine frage ?
Alex
Hi Bert hatte noch was vergessen zu Fragen, kann man den Code auch für zwei blätter machen. Das heisst wenn zwei blätter kopiert werden. Mit deinem Code nimmt er das für eine weg. Habe aber noch eine andere Arbeitsmappe wo zwei Blätter kopiert werden. Ist das auch möglich.
Vielen Dank für Deine hilfe
Gruß Alex
AW: Sorry Bert noch eine frage ?
geri
Hallo Alex
Worksheets(Array("Lieferschein", "Angebot", "Rechnung")).Copy
ändere Zeile 2 passe deine Blattnamen an
gruss geri
Hi Geri nicht ganz korrekt
alex
Hi Geri,
habe ein Code für zwei Arbeitsblätter. Mir geht es nur darum das er mir das bei den Kopierten blättern nur bei einer die Codes und Grafiken mit dem Code ent fernt dies soll aber bei beiden geschehen das löschen der Grafiken und VBA Codes beim Kopieren.

Sub Speichermakro1()
Dim Speicher
Dim DeinPfad
DeinPfad = "R:\T2\T2S\T2S-Personaldaten\T2S-Statistik\2005\T2S - "
Sheets(Array("Auftrags Statistik", "HA. Statistik")).Copy
Sheets("Auftrags Statistik").Unprotect
Sheets("HA. Statistik").Unprotect
Worksheets(Array("Lieferschein", "Angebot", "Rechnung")).Copy
ActiveSheet.DrawingObjects.Delete   'dieser Code ist für ein Blatt und nicht für 2
Sheets(Array("Auftrags Statistik", "HA. Statistik")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Sheets("Auftrags Statistik").Select
Sheets("Auftrags Statistik").Protect
Sheets("HA. Statistik").Protect
Speicher = Format(Now, "dd.mm.yy") & " Statistik.xls"
ActiveWorkbook.SaveAs Filename:=DeinPfad & Speicher
ActiveWorkbook.Close SaveChanges:=False
End Sub

Anzeige
teste mal denke so gehts
geri
Hallo Alex

Sub Speichermakro2()
Dim Speicher
Dim DeinPfad
DeinPfad = "R:\T2\T2S\T2S-Personaldaten\T2S-Statistik\2005\T2S - "
Sheets(Array("Auftrags Statistik", "HA. Statistik")).Copy
Sheets("Auftrags Statistik").Unprotect
Sheets("HA. Statistik").Unprotect
Sheets(Array("Auftrags Statistik", "HA. Statistik")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Sheets("Auftrags Statistik").Select
ActiveSheet.DrawingObjects.Delete
Sheets("Auftrags Statistik").Protect
Sheets("HA. Statistik").Select
ActiveSheet.DrawingObjects.Delete
Sheets("HA. Statistik").Protect
Speicher = Format(Now, "dd.mm.yy") & " Statistik.xls"
ActiveWorkbook.SaveAs Filename:=DeinPfad & Speicher
ActiveWorkbook.Close SaveChanges:=False
End Sub

gruss geri
Anzeige
Danke Geri klappt super !!! o.T
Alex
Danke Geri klappt super. o.T.
Gruß Alex

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige