Bepaalde kolommen opslaan als .PDF en mailen naar$$$ als .PDF

[sph]

Hoe kan ik via een VBA bepaalde kolommen opslaan als een .PDF of mailen naar een bepaald adres als .PDF?

 

[sph]

Onderstaande code houdt nog geen rekening met het aantal argumenten,
maar als dat al zo was dan is nu mijn probleem dat elke kolom op een ander blad in de PDF geplaatst wordt.

Sub opslaan_als_pdf()
'
' opslaan_als_pdf Macro
'

'
    Range("K14,B2:B10,D2:D10,G2:G10").Select
    Range("G2").Activate
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf", Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    Range("B2").Select
End Sub

 

[HSV]

Maak een tweede blad aan in je werkboek.

Sub hsv()
Dim Tb As Range
With Sheets(1)
  Set Tb = Union(.Columns(2).SpecialCells(2), .Columns(4).SpecialCells(2), .Columns(7).SpecialCells(2))
  Tb.Copy Sheets(2).[a1]
  Sheets(2).Cells(1).CurrentRegion.ExportAsFixedFormat 0, [COLOR=#3E3E3E]"C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"[/COLOR], , , , , , True
End With
End Sub

Zo wil je het mailen?

 

[sph]

Hier heb ik de hulpkolommen verborgen.
Met een printmacro in de linkse knop print ik mijn selectie uit waarbij de verborgen kolommen ook niet afgedrukt worden.
Is ditzelfde trucje niet met een pdf export te doen?

 

[sph]

Maak een tweede blad aan in je werkboek.

Sub hsv()
Dim Tb As Range
With Sheets(1)
  Set Tb = Union(.Columns(2).SpecialCells(2), .Columns(4).SpecialCells(2), .Columns(7).SpecialCells(2))
  Tb.Copy Sheets(2).[a1]
  Sheets(2).Cells(1).CurrentRegion.ExportAsFixedFormat 0, [COLOR=#3E3E3E]"C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"[/COLOR], , , , , , True
End With
End Sub

Zo wil je het mailen?

Het werkelijke excel bestand bestaat uit mogelijk 3000 regels met heel veel voorwaardelijke opmaken.
Een kopie hiervan naar een (in dit geval 6e blad) zou erg omslachtig zijn.

 

[HSV]

Aub niet qouten.
Gebruik de "Reageer op bericht" knop.

Beter?

Sub hsv()
Dim tb As Range
 Set tb = Union(Columns(3), Columns(5).Resize(, 2))
 tb.EntireColumn.Hidden = True
Sheets(1).ExportAsFixedFormat 0, "C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf", , , , , , True
End Sub

 

[sph]

Okee dat lijkt er op!
De code zelf kan ik alleen niet ontcijferen.

In mijn geval heb ik zo ongeveer 12 kolommen naast elkaar.
Hoe krijg ik dat netjes naast elkaar in 1 PDF?

Omdat ik in de meeste kolommen 3000 rijen formules heb wil ik alleen de gevulde cellen exporteren als .PDF.
Ik heb daarom in een bepaalde cel (A1) het aantal argumenten staan.
Ik pas op dit moment jouw code op het bestand toe, maar hij blijft heel lang aan het 'publiceren'.

 

[HSV]

Geef even aan welke kolommen verborgen moeten worden.

Sub hsv()
Dim tb As Range
With Sheets(1)
 Set tb = Union(.Columns(3), .Columns(5).Resize(, 2))
 tb.EntireColumn.Hidden = True
      With .PageSetup
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
       End With
   .ExportAsFixedFormat 0,"C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"
 tb.EntireColumn.Hidden = False
End With
End Sub

Dan laten we het publiceren achterwege.

 

[sph]

De geëxporteerde kolommen:

a b c d f g h i j k l y z aa ac ad ae aj ak ao (20 kolommen, niet gedacht)

Het aantal rijen heb ik in cel A1 staan (aantalarg)+1

De breedte van de kolommen in mijn werkblad is niet in stand gehouden helaas.

 

[HSV]

Je .Pdf wordt er vast niet leesbaarder van.

Sub hsv()
Dim tb As Range
With Sheets(1)
 Set tb = Union(.Columns(5), .Columns(13).Resize(, 12), Columns(28), Columns(32).Resize(, 4), Columns(38).Resize(, 3))
 tb.EntireColumn.Hidden = True
      With .PageSetup
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
       End With
   .ExportAsFixedFormat 0, [COLOR=#3E3E3E]"C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"[/COLOR]
 tb.EntireColumn.Hidden = False
End With
End Sub

 

[sph]

Hij blijft bij mij op publiceren hangen, ik ben bang dat hij alle 3000 rijen meeneemt?

 

[HSV]

Het publiceren staat niet aan in de code.

 

[sph]

Hmmm. Raar.

 

[HSV]

Test dit maar eens.
Er wordt een nieuw blad aangemaakt en na het het exporteren wordt dat blad weer verwijderd.

Sub hsv()
Dim tb As Range
Application.EnableEvents = False
With Sheets(1)
 Set tb = Union(.Columns(1).Resize(.[a1], 4), .Columns(6).Resize(.[a1], 7), .Columns(25).Resize(.[a1], 3), .Columns(29).Resize(.[a1], 3), .Columns(36).Resize(.[a1], 2), .Columns(41).Resize(.[a1], 1))
   Sheets.Add , Sheets(Sheets.Count)
   tb.Copy Sheets(Sheets.Count).Cells(1)
                                                                                  
      With .PageSetup
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
       End With
  Sheets(Sheets.Count).ExportAsFixedFormat 0, "C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"
  Application.DisplayAlerts = False
 Sheets(Sheets.Count).Delete
  Application.DisplayAlerts = True
End With
End Sub

 

[sph]

Mooi Harry, dit werkt op zich goed.
Alleen is de breedte van de kolommen en de grootte van de ingevoegde afbeeldingen uit zijn verband gerukt en bestaat de pdf uit meerdere bladzijden ipv uit 1 overzichtslijst.

Het verhaal achter mijn excel bestand is dat onze klanten allemaal dagelijks een mail met al hun apparatuur en de status daarvan in een overzichtelijke lijst ontvangen.
Deze apparatuur is aan periodieke keuring onderhevig en daarom zijn b.v. voorwaardelijke opmaak en data (datums) heel belangrijk.
Als ik de print macro gebruik staat alles perfect op een A4tje, waarom is het online publiceren van dit A4tje zo moeilijk?
Moet ik deze echt elke keer uitprinten, inscannen en dan op die manier mailen?

 

[HSV]

Voeg onderstaande rode regels eens in.

Sub hsv()
Dim tb As Range
Application.EnableEvents = False
With Sheets(1)
 Set tb = Union(.Columns(1).Resize(.[a1], 4), .Columns(6).Resize(.[a1], 7), .Columns(25).Resize(.[a1], 3), .Columns(29).Resize(.[a1], 3), .Columns(36).Resize(.[a1], 2), .Columns(41).Resize(.[a1], 1))
   Sheets.Add , Sheets(Sheets.Count)
   tb.Copy Sheets(Sheets.Count).Cells(1)
 [COLOR=#ff0000] sheets(sheets.count).columns.autofit[/COLOR]
                                                                                  
      With .PageSetup
      [COLOR=#ff0000]   .PaperSize = xlPaperA4[/COLOR]
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
       End With
  Sheets(Sheets.Count).ExportAsFixedFormat 0, "C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"
  Application.DisplayAlerts = False
 Sheets(Sheets.Count).Delete
  Application.DisplayAlerts = True
End With
End Sub

 

[sph]

Het ziet er nu nog mooier uit, maar in de aangemaakte PDF zie ik alles opgesplitst in bladzijden.
Kan ik mijn bestand naar jou mailen zodat je ziet wat ik bedoel?

 

[HSV]

Nieuwe poging.

Sub hsv()
Dim tb As Range
Application.EnableEvents = False
With Sheets(1)
  Sheets.Add , Sheets(Sheets.Count)
   .Cells(1).Resize(.Cells(1).Value, .UsedRange.Columns.Count).Copy
    With Sheets(Sheets.Count)
        .Cells(1).PasteSpecial (xlPasteAll) '-4104
        .PasteSpecial (xlPasteColumnWidths) '8
     Set tb = Union(.Columns(5), .Columns(13).Resize(, 12), .Columns(28), .Columns(32).Resize(, 4), .Columns(38).Resize(, 3))
    
       With .PageSetup
         .Orientation = xlLandscape
         .PaperSize = xlPaperA4
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 5
       End With
    
        tb.Delete
      End With
    End With
   'Sheets(Sheets.Count).UsedRange.ExportAsFixedFormat 0, "C:\Users\hsv\desktop\hsv"
   Sheets(Sheets.Count).ExportAsFixedFormat 0, "C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"
  Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
  Application.DisplayAlerts = True
End Sub

 

[sph]

Ik heb nu een PDf met 114 lege pagina`s, met op pagina 1 de lijst maar dan heel klein waarbij de tekst door de lijnen loopt
Ik hou je wel bezig volgens mij?

 

[HSV]

Kun je het origineel plaatsen zonder gevoelige info.
Het best is dan in binaire extensie (,xlsb).

Overigens krijg ik het aantal pagina's die wordt bepaalt door cel A1.