print Area opslaan als xls file

[isitmeor]

is het mogenlijk om een Print Area op te slaan als xls bestand
de print area bevat ook images en cel opmaak

 

[robdgr]

Bij opslaan blijft je print area altijd gewoon bestaan, dus wat is het probleem?

 

[isitmeor]

ik wil dus een print area dmv een vba opslaan

 

[VenA]

Zoals in het andere draadje al aangegeven ook jouw voorbeeldbestand even plaatsen.

De code zal zoiets worden.

Sub VenA()
Sheets("Factuur").Copy
  With ActiveSheet
    .Unprotect
    For Each sh In .Shapes
      If sh.Name <> "NaamLogo" Then sh.Delete
    Next sh
    .Columns("I:AB").Delete
    .Name = "Fatuur " & .[G4]
  End With
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs "E:\Temp\" & [G4] & ".xls", 56
End Sub

 

[edmoor]

Voorbeeldje van Experts Exchange:

Saving a Print Area as a New Workbook

Sub Mane()
    Application.DisplayAlerts = False

    Dim This_ As Excel.Workbook
    Dim Xl As Excel.Workbook
    Dim C3 As String
    Dim C4 As String
    Dim Print_ As String

    Set This_ = ThisWorkbook
    C3 = This_.Worksheets("Sheet1").Range("c3")
    C4 = This_.Worksheets("Sheet1").Range("c3")
    Print_ = This_.Worksheets("Sheet1").PageSetup.PrintArea

    Set Xl = Workbooks.Add
    With Xl
        This_.Worksheets("Sheet1").Range(Print_).Copy
        .Worksheets(1).Range("a1").PasteSpecial Paste:=xlValues
        .SaveAs Filename:="C:\" & C3 & "_" & C4 & ".xlsx"
    End With
    Xl.Close
    Application.DisplayAlerts = True
End Sub

 

[isitmeor]

@VenA
sorry voor de onduidelijkheid en hartelijk dank ik heb het een beetje aangepast en het werkt prima

 

[VenA]

Graag gedaan. Plaats voor de volledigheid even het bestand en de aanpassingen. Dan hebben anderen die zoeken op 'print Area opslaan' er mogelijk ook wat aan. En daarna mag je de vraag op opgelost zetten.:d

 

[isitmeor]

file

Bekijk bijlage test-Faktuur2r01.xlsm