ich habe ein Makro "zusammenbebastelt" welches die aktuelle Tabelle
speichert.
Funktioniert einwandfrei !
Nun möchte ich das das Modul "mod_alles" mit in die neue Datei
reinkopiert wird.
Ich hab natürlich keinen Schimmer...wo ich das Makro reinsetzen soll.
Hier mein Makro:
Public Sub Sigrid_NEU_BlattSpeichern()
Dim TBName$
Dim tan
tan = ActiveSheet.Name
TBName = ActiveSheet.Name
'ActiveSheet.Unprotect (getStrPasswort)
Dim WBName As String, varAntwortMsg
Do
WBName = InputBox(Chr(13) & Chr(13) & _
"JETZT im blau makierten Feld Kunden-Name eingeben: " & Chr(13) & Chr(13) & _
_
" NUR Namen, kein DOPPELPUNKT, kein Schrägstrich !", _
"Kunden-Namen für Datei >", tan & ".xls")
If Not sichererDateiname(WBName) Then
If MsgBox("Dateiname enthält ungültige Sonderzeichen." & Chr(10) & _
"Nochmal probieren?", vbYesNo) = vbNo Then Exit Sub
Else
Exit Do
End If
Loop
ActiveSheet.Range("D1") = WBName
If WBName = "" Then Exit Sub
ActiveSheet.Unprotect (getStrPasswort)
Worksheets(TBName).Copy
'--- so jetzt noch ins Verzeichnis speichern -------------
Dim Fs As Object, OrdNam As Variant, Ord As Byte, Pfad As String
Dim DateiNam As String
Dim aDatei As String
Dim strPath$
DateiNam = WBName & " " & "Rg.-Nr. " & ActiveSheet.Range("I23") & " - " & ActiveSheet.Range(" _
J23") & " " _ & ActiveSheet.Range("E23") & ".xls"
'Pfad
strPath = "C:\_Sigi\__Dokumente\__Rechnungen\"
With ActiveSheet 'Tabelle anpassen
If IsDate(.Range("J18")) Then
If .Range("J18") > 0 Then
'Pfad Jahr
strPath = strPath & Year(.Range("J18").Value) & "\"
'Pfad Monat
strPath = strPath & Format(.Range("J18").Value, "MM MMMM") & "\"
'Ordner erstellen sollte dieser nicht vorhanden sein
apiCreateFullPath strPath
'Pfad Dateiname
strPath = strPath & DateiNam '''''''ActiveWorkbook.Name
'Prüfung ob vorhanden
If Dir(strPath, vbNormal) "" Then
MsgBox "Kunden-Name " & DateiNam & Chr(13) & Chr(13) & _
"mit der Rg. - Nr. ist vorhanden !" & vbLf & vbLf & "Bitte ändern !"
' strPath = ActiveWorkbook.FullName
' On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Close ''True
' Kill strPath
' ActiveWindow.Close
Exit Sub ' ich eingesetzt
Else
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPath, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
End If
End If
End If
End With
'- vorhandene button löschen -----------------------
'''' On Error Resume Next 'raus 25.4.16
ActiveSheet.Shapes("CommandButton7").Delete
ActiveSheet.Shapes("CommandButton8").Delete 'zur Rechnungs-Auswahl
ActiveSheet.Shapes("CommandButton1").Delete ' korrektur speichern
ActiveSheet.Shapes("CheckBox3").Delete ' korrektur einschalten
''''' On Error GoTo 0
ActiveSheet.Application.ScreenUpdating = False
'----- jetzt schutz setzen --------------
Dim akw As String
akw = ActiveWorkbook.Name
Dim Password As String
Password = "wwpa"
Dim vbext_pp_none
Dim wb As Workbook, ok As Boolean, s As String
Set wb = Application.Workbooks(akw)
If ActiveSheet.Name = "Rechnung MG" Then
Call Arbeitsmappe_Makro_schreiben_Neu_MG
End If
End If
ActiveWorkbook.SaveAs Filename:=strPath, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close True
Set wb = Nothing
'ActiveSheet.Unprotect (getStrPasswort)
''----- hier die Vorlage löschen -----------------------------------
ActiveSheet.Range("C11:C16").ClearContents ' seite 1
If ActiveSheet.Name = "Rechnung1" Then
ActiveSheet.Unprotect (getStrPasswort)
Sheets("Rechnung1").CheckBox1.Value = False
ActiveSheet.Range("D1") = ThisWorkbook.Sheets("Rechnungs-Auswahl").Range("A46")
ActiveSheet.Range("C11").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:=getStrPasswort
End If
ActiveSheet.Range("D1") = ThisWorkbook.Sheets("Rechnungs-Auswahl").Range("A46")
ActiveSheet.Range("C11").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:=getStrPasswort
ActiveSheet.Range("D1") = ThisWorkbook.Sheets("Rechnungs-Auswahl").Range("A46")
ActiveSheet.Range("C11").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:=getStrPasswort
End If
If ActiveSheet.Name = "Slozinskima" Then
ActiveSheet.Unprotect (getStrPasswort)
Sheets("Slozinskima").CheckBox1.Value = False
ActiveSheet.Range("D1") = ThisWorkbook.Sheets("Rechnungs-Auswahl").Range("A46")
ActiveSheet.Range("C11").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:=getStrPasswort
End If
ActiveSheet.Application.ScreenUpdating = True
End Sub
Hoffentlich blickt jemand durch, würde mich freuen !gruß sigrid