Projekt-Anfragen: Tel: 07022/9319004 info@CodeDocu.de Software Entwicklung in C# WPF Asp.Net Core Vba Excel Word SQL-Server EF Linq, UWP Net
#

 

 

Um die Blätter an das Ende der neuen Datei zu kopieren:

    Dim wsExport As Worksheet

    ws.Copy After:=workbook_Export.Sheets(workbook_Export.Worksheets.Count)

 

 

 

 

 

 

Option Explicit

 

'***********< Ausgabe >****************

'*Ausgabe_Datei erstellen

 

Public Const °Ausgabeordner = "07_Ausgabe"

 

Public Sub AusgabeDatei_erstellen()

    '-----------------< AusgabeDatei_erstellen() >-----------------

    '< active Workbook >

    Dim wb As Workbook

    Set wb = ActiveWorkbook

    '</ active Workbook >

 

    '< check_Ordner >

    Application.StatusBar = Now & " check Ausgabeordner: " & ThisWorkbook.Path & "\" & °Ausgabeordner

   

    Dim fs As FileSystemObject

    Set fs = New FileSystemObject

    If fs.FolderExists(ThisWorkbook.Path & "\" & °Ausgabeordner) = False Then

        fs.CreateFolder ThisWorkbook.Path & "\" & °Ausgabeordner    'erstellen

    End If

    Set fs = Nothing

    '</ check_Ordner >

 

 

    '----< AusgabeDatei_erstellen >----

    Application.StatusBar = Now & " erstelle Ausgabedatei.."

    DoEvents

    Application.ScreenUpdating = False

   

    '< delete_sheet1 >

    Dim workbook_Export As Workbook

    Set workbook_Export = Workbooks.Add()

   

    '< Design-Farb-Schema uebernehmen >

    workbook_Export.ApplyTheme wb.FullName

    '</ Design-Farb-Schema uebernehmen >

   

    Application.DisplayAlerts = False   '*suppress alert: delete sheet1 und save.overwrite

    '</ delete_sheet1 >

   

    '----< Sheets ermitteln >----

    Dim ws As Worksheet

 

    '--< @Loop: alle Sheets >--

    For Each ws In wb.Sheets

        If ws.Visible = xlSheetVisible Then

            If ws.Range("A1").Value = "96dpi" Then

                Application.StatusBar = Now & " Ausgabeblatt:" & ws.Name

                Ausgabeblatt_uebertragen wb, ws, workbook_Export

            End If

        End If

    Next

    '--< @Loop: alle Sheets >--

   

    '##--< Export_Anpassen >--##

    Verlinkungen_loeschen_Arbeitsmappe workbook_Export

    Names_loeschen_Arbeitsmappe workbook_Export

    '##--</ Export_Anpassen >--##

   

 

    '< save >

    Application.DisplayAlerts = False

    workbook_Export.Sheets("Tabelle1").Delete

    Application.StatusBar = Now & "speichern Datei: " & workbook_Export.Name

   

    Dim Monatskennung As String

    Monatskennung = wb.Names("Monatskennung").RefersToRange.Value

    workbook_Export.SaveAs wb.Path & "\" & °Ausgabeordner & "\MMLetter_" & Monatskennung

    '</ save >

   

    workbook_Export.Close

    Set workbook_Export = Nothing

    Application.DisplayAlerts = True

  

 

    Application.StatusBar = Now & " fertig: Datei ausgeben"

    '-----------------</ AusgabeDatei_erstellen() >-----------------

End Sub

 

 

Public Sub Ausgabeblatt_uebertragen(ByRef wb As Workbook, ByRef ws As Worksheet, ByRef workbook_Export As Workbook)

    '-----------------< Eingabeblatt_einlesen() >-----------------

    ws.Activate

   

    '----< Sheets ermitteln >----

    Application.StatusBar = Now & " export Blatt: " & ws.Name

    DoEvents

    Application.ScreenUpdating = False

   

   

    Dim wsExport As Worksheet

    ws.Copy After:=workbook_Export.Sheets(workbook_Export.Worksheets.Count)

   

   

   

    '< Ansicht >

    Set wsExport = workbook_Export.Sheets(ws.Name)

    workbook_Export.Activate

    ActiveWindow.View = xlPageBreakPreview '*Ansicht auf PrintPreview xlPageBreakPreview xlLandscape xlNormalView

    '</ Ansicht >

   

    '##--< Export_Anpassen >--##

    Zeilen_Spalten_auf_Blatt_einausblenden wsExport, SetAnsicht:=False

    '##--</ Export_Anpassen >--##

   

    '--< Logo_rechts_platzieren >--

   

    '< get_Page >

    Dim range_PrintArea As Range

    Set range_PrintArea = wsExport.Range(wsExport.PageSetup.PrintArea)

    '</ get_Page >

   

    Dim posRight_Page_Margin As Double

    posRight_Page_Margin = range_PrintArea.Left + range_PrintArea.Width

   

    '< Logo_Picture >

    Dim picLogo As Shape

    For Each picLogo In wsExport.Shapes

        If picLogo.Type = msoPicture Then Exit For

    Next

    '</ Logo_Picture >

   

    '< set Position >

    picLogo.Left = posRight_Page_Margin - picLogo.Width - 1

    picLogo.Top = 1

    '</ set Position >

    '--</ Logo_rechts_platzieren >--

   

   

    '< close >

    Application.StatusBar = Now & "Datei ausgabe erledigt.: " & ws.Name

    '</ close >

   

    '-----------------</ Eingabeblatt_einlesen() >-----------------

End Sub

 

 

 

 

 

 

 

vv

 

Mobile
»
Vba Makro Code: So erstellt man ein Excel Workbook und Sheet zur Laufzeit ohne Excel Verweis
»
Office Verzeichnis Dialog ohne Verweis auf ObjectLibrary
»
Ändern von vba Code zu Late Binding ohne dll-Verweis Dim Excel Word as Object
»
Excel Datei mit Schutz mit erlaubtem Farbformatierungen, Kommentaren und Sperren von Formelfeldern
»
Excel vba Fehler: Laufzeitfehler 1004 Die Locked-Eigenschaft des Range-Objektes kann nicht festgelegt werden
»
Excel Datei schützen
»
Excel Blatt schützen: Protect Parameter
»
Excel vba : Alle Worksheets auflisten
»
Vba: Sonderzeichen austauschen korrigieren
»
Gelöst: Excel vba copy paste values 100e Fehler

.

Jobs, Projekte, Angebote für Freiberufler, Selbstständig an Info@CodeDocu.de