FitToPagesWide

Status
Niet open voor verdere reacties.
D

DeArie

Gebruiker
Lid geworden
15 jul 2016
Berichten
124
Goedemiddag,

Ik ben aan het proberen om als ik een Excel bestand met onderstaande code's opsla/afdruk en/of mail dat deze in de breedte aangepast wordt om op 1 A4 te passen. Het lukt me wel alles zover te verkleinen maar dan wordt t bijna onleesbaar want dan verkleint hij hem ook in de lengte, maar dan mag hij best op meerdere pagina's komen.

Ik heb de volgende code ook hier ergens gevonden op Helpmij en geprobeerd op diverse plaatsen ertussen te zetten maar zonder het gewenste resultaat

Code: 
Sheets(2).PageSetup.FitToPagesWide = 1

de hele code's waarin deze verwerkt zouden moeten worden zijn de volgende:

Code: 
Sub Efactuur()

Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True

Sheets(1).Select

'zet naam tabblad in cel G1 en vult bedragen in
Dim naam
naam = Worksheets(2).Name ' (2) is tweede tabblad van een sheet
ActiveSheet.Range("G8") = Mid(naam, 1, 6)
Range("J53") = Sheets(2).Cells(Rows.Count, 7).End(xlUp).Value
Range("J56") = Sheets(2).Cells(Rows.Count, 9).End(xlUp).Value
Sheets(Array(1, 2)).Select
    Sheets(1).Activate

With Sheets(1)
    Worksheets(1).PageSetup.FitToPagesWide = 1
  .Range("B17") = Format(CreateObject("scripting.filesystemobject") _
        .getfolder("C:\Users\D-post\OneDrive\Documenten\D-post\facturen\").Files.Count, "202000000") + 1
.Range("D17").Value = Date
pad = "C:\Users\D-post\OneDrive\Documenten\D-post\facturen\"
.ExportAsFixedFormat xlTypePDF, pad & .Range("B17").Value & ".pdf"
Windows(1).SelectedSheets.Copy
ActiveWorkbook.Close 0

   
End With

    'Worksheets(2).PageSetup.Orientation = xlPortrait
    'Worksheets(2).PageSetup.Zoom = False
    'Sheets(sh).PageSetup.FitToPagesTall = 1
    'Sheets(2).PageSetup.FitToPagesWide = 1
    'ActiveSheet.PrintOut

Sheets(Array(1, 2)).Select

Dim Bestand As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim signature As String
    
    Bestand = Environ("TEMP") & "\" & ActiveSheet.Name & " " & Range("B17").Value & ".pdf"
    ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=Bestand
    
    mailto = ActiveSheet.Range("G12")
    subject = "Factuur van de maand " & Format(Date - 28, "mmmm")
    Body = "Geachte relatie, <br><br>" & _
           "Hierbij doen wij u onze factuur toekomen van de door ons verleende diensten van de afgelopen maand. <br>" & _
           "Met het vriendelijke verzoek om voor betaling zorg te dragen." _


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .display
        signature = .HTMLBody
        .To = mailto
        .CC = ""
        .BCC = ""
        .HTMLBody = "<Body style='color:black(33,38,227);font-family:calibri;font-size:15'></font></p>" & Body & "<br>" & .HTMLBody
        .subject = subject
        .Attachments.Add Bestand
        .Send
    End With
    Kill Bestand
    
'Application.Run "PERSONAL.XLSB!Efactuur"
  
End Sub

Code: 
Sub FactuurBriefpapier()
'zet naam tabblad in cel G1 en vult bedragen in
Dim naam
naam = Worksheets(2).Name ' (2) is tweede tabblad van een sheet
ActiveSheet.Range("G1") = Mid(naam, 1, 6)
Range("J45") = Sheets(2).Cells(Rows.Count, 7).End(xlUp).Value
Range("J48") = Sheets(2).Cells(Rows.Count, 9).End(xlUp).Value
Sheets(Array(1, 2)).Select
    Sheets(1).Activate

With Sheets(1)
  .Range("B10") = Format(CreateObject("scripting.filesystemobject") _
        .getfolder("C:\Users\D-post\OneDrive\Documenten\D-post\facturen\").Files.Count, "202000000") + 1
.Range("D10").Value = Date
pad = "C:\Users\D-post\OneDrive\Documenten\D-post\facturen\"
.ExportAsFixedFormat xlTypePDF, pad & .Range("B10").Value & ".pdf"
Windows(1).SelectedSheets.Copy
ActiveWorkbook.Close 0

   
End With

For sh = 1 To 2
    'Sheets(sh).PageSetup.Orientation = xlPortrait
    'Sheets(sh).PageSetup.Zoom = False
    'Sheets(sh).PageSetup.FitToPagesTall = 1
    Sheets(sh).PageSetup.FitToPagesWide = 1
    'Sheets(sh).PrintOut
    
Next

Application.DisplayAlerts = False
         blad = Worksheets(2).Name
              Sheets(2).Select
                  Sheets(2).Delete

Application.DisplayAlerts = True

Sheets(1).Select

Application.Run "PERSONAL.XLSB!FactuurZonderLogo.FactuurZonderLogo"


End Sub

Kan iemand mij helpen en graag uitleggen waarom dit zo niet werkt?

Alvast dank.
 
Ik zie nogal wat foutlopen...

Om te beginnen : als je declaraties (dim) moeten vooraan ! de procedure staan, eerste punt na de 'Sub' ...
 
Heb je dit in een bestandje ... ? Stuur dat eens door want anders is er geen beginnen aan ...
 
In je code heb je ergens staan.
Code: 
Worksheets(1).PageSetup.FitToPagesWide = 1
Maak er eens het volgende van
Code: 
Worksheets(1).PageSetup.FitToPagesWide = 1
Worksheets(1).PageSetup.FitToPagesTall = 0
 
Beste DigiCafee,

Dank voor je reactie, moet heel eerlijk bekennen dat ik niet echt begrijp wat je bedoelt. De code zoals hij hier staat doet precies wat ik voor ogen heb.
Het enige wat ik nu probeer te bereiken is dat hij het tweede blad in de breedte op 1 blad houdt en in de lengte mag hij wel meerdere bladen gebruiken.

Zolang hij alleen in de breedte buiten het printbereik gaat werkt
Code: 
Worksheets(1).PageSetup.FitToPagesWide = 1
wel goed.
Op het moment dat hij ook in de lengte buiten het 1e blad gaat verkleind hij het hele spul zo klein dat het amper te lezen is.

Ik heb een voorbeeld van mijn werkbestanden toegevoegd.
 

Bijlagen

  • test bestand.xlsx
    51,1 KB · Weergaven: 33
Beste Pagadder,

Dank voor je reactie, helaas geeft dit alleen een fout melding:
2020-06-03 (1).png
 
misschien ipv 0 een (te) groot getal
Code: 
Sub Afdrukken()
   With ActiveSheet.PageSetup
      .FitToPagesWide = 1
      .FitToPagesTall = 99999
      .Parent.PrintPreview
   End With
End Sub
 
Laatst bewerkt:
Beste Cow18,

Dank je wel dat is inderdaad de oplossing, wat zijn die getallen erachter dan? Het aantal lijnen wat meegenomen wordt in de versmalling?
 
je zegt gewoon dat hij de ganse boel moet afdrukken op
- in de lengte, 99.999 paginas (nobele onbekende)
- in de breedte, 1 pagina. (zoals gevraagd)

Die lengte, dat weet je vooraf gewoon niet.
Dat is telkens anders, maar je neemt gewoon een gruwelijk hoog getal (had bv. ook 99 kunnen zijn) om safe te spelen.
Misschien had jij beter een inschatting maken, wat het maximaal aantal paginas zou kunnen zijn in de meest extreme situatie, maar bouw daar dan nog maar rustig een veiligheidsmarge in.

Had je 100 gezegd en kan hij het afdrukken op 10 in de lengte, wel, zo veel te beter, hij neemt die 10 en je krijgt een deftig resultaat.
Had je 10 gezegd en hij moest zo nodig het op een deftige manier afdrukken op 100 paginas, wel dan krijg je 10 paginas postzegels, die je moet bekijken onder vergrootglas.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan