• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

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

  • Onderwerp starter Onderwerp starter sph
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
A1 is het aantal regels :)

Maar als .xlsb is het bestand 2,5mb
Ik krijg het hier niet geplaatst, en uitgekleed werkt het niet door alle formules en verwijzingen.
 
Het aantal regels begrijp ik en wordt ook gehanteerd in de code.
Kopieer het blad en plak het met waarden door 'plakken speciaal' te gebruiken.
Dat blad kun je op het forum plaatsen.
 
Zo zal het vast beter gaan.
Je had namelijk een usedrange tot de laatste kolom van het werkblad.
Code: 
sub hsv()
Dim tb As Range
Application.ScreenUpdating = False
With Sheets(1)
  Sheets.Add , Sheets(Sheets.Count)
   .Cells(1).Resize(.Cells(1).Value, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
    With Sheets(Sheets.Count)
        .Cells(1).PasteSpecial (xlPasteAll) '-4104
        .PasteSpecial (xlPasteColumnWidths) '8
        .UsedRange.Value = .UsedRange.Value
     Set tb = Union(.Columns(5), .Columns(13).Resize(, 12), .Columns(28), .Columns(32).Resize(, 4), .Columns(38).Resize(, 3))
     tb.Delete
       With .PageSetup
         .Orientation = xlLandscape
         .PaperSize = xlPaperA4
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 10
       End With
    
       
      End With
    End With
   Sheets(Sheets.Count).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
 
Jouw onderstaande regel wordt geel en geeft foutmelding 1004?

Code: 
.Cells(1).Resize(.Cells(1).Value, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
 
Vreemd, in het bestand wat je meegezonden hebt niet.
 

Bijlagen

Okee hier thuis werkt dit wel, op mijn werk niet.
Maandag nog eens proberen.
Het werkt ieg perfect en daarvoor heel erg bedankt!
Heb hem een beetje aangepast om tijd en datum in bestandsnaam te zetten.
Is er een manier om deze pdf gelijk te verzenden per mail naar een mailadres in cel "BEDRIJFSINFO!A4"?
Maar nogmaals, heel erg bedankt!!

Code: 
Sub export_pdf()
Dim tb As Range
Application.ScreenUpdating = False
With Sheets(1)
  Sheets.Add , Sheets(Sheets.Count)
   .Cells(1).Resize(.Cells(1).Value, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
    With Sheets(Sheets.Count)
        .Cells(1).PasteSpecial (xlPasteAll) '-4104
        .PasteSpecial (xlPasteColumnWidths) '8
        .UsedRange.Value = .UsedRange.Value
     Set tb = Union(.Columns(5), .Columns(13).Resize(, 12), .Columns(28), .Columns(32).Resize(, 4), .Columns(38).Resize(, 3))
     tb.Delete
       With .PageSetup
         .Orientation = xlLandscape
         .PaperSize = xlPaperA4
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 10
       End With
    
       
      End With
    End With
    aanduiding = Format(CStr(Now), "dd-mm-yy_hh-mm-ss")
   Sheets(Sheets.Count).ExportAsFixedFormat 0, "F:\Klanten\Equipment Overviews\" & Range("BEDRIJFSINFO!A2").Value & "_" & aanduiding & ".pdf"
  Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
  Application.DisplayAlerts = True
End Sub
 
Laatst bewerkt:
Incl. mailen via Outlook.

Code: 
Sub hsv()
Dim tb As Range
Application.ScreenUpdating = False
With Sheets(1)
  Sheets.Add , Sheets(Sheets.Count)
   .Cells(1).Resize(.Cells(1).Value, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
    With Sheets(Sheets.Count)
        .Cells(1).PasteSpecial (xlPasteAll) '-4104
        .PasteSpecial (xlPasteColumnWidths) '8
        .UsedRange.Value = .UsedRange.Value
     Set tb = Union(.Columns(5), .Columns(13).Resize(, 12), .Columns(28), .Columns(32).Resize(, 4), .Columns(38).Resize(, 3))
     tb.Delete
       With .PageSetup
         .Orientation = xlLandscape
         .PaperSize = xlPaperA4
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
       End With
     End With
    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
  With CreateObject("Outlook.Application").CreateItem(0)
        .to = "testje@mail.com"
        .Subject = "zomaar een mailtje"
        .Body = "Geachte heer/mevrouw,"
        .attachments.Add "C:\Users\steve\Documents\Kopie van als-pdf-mailen-en-opslaan-1.pdf"
        .display
        '.send  'ipv .display om direct te verzenden
      End With
End Sub
 
Ik ga hem maandagochtend gelijk proberen!
Is mijn onderstaande aanpassing foutloos?

Code: 
Sub export_pdf()
Dim tb As Range
Application.ScreenUpdating = False
With Sheets(1)
  Sheets.Add , Sheets(Sheets.Count)
   .Cells(1).Resize(.Cells(1).Value, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
    With Sheets(Sheets.Count)
        .Cells(1).PasteSpecial (xlPasteAll) '-4104
        .PasteSpecial (xlPasteColumnWidths) '8
        .UsedRange.Value = .UsedRange.Value
     Set tb = Union(.Columns(5), .Columns(13).Resize(, 12), .Columns(28), .Columns(32).Resize(, 4), .Columns(38).Resize(, 3))
     tb.Delete
       With .PageSetup
         .Orientation = xlLandscape
         .PaperSize = xlPaperA4
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 10
       End With
    
       
      End With
    End With
    aanduiding = Format(CStr(Now), "dd-mm-yy_hh-mm-ss")
   Sheets(Sheets.Count).ExportAsFixedFormat 0, "F:\Klanten\Equipment Overviews\" & Range("BEDRIJFSINFO!A2").Value & "_" & aanduiding & ".pdf"
  Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
  Application.DisplayAlerts = True
With CreateObject("Outlook.Application").CreateItem(0)
        .to = Range("BEDRIJFSINFO!A3").Value
        .Subject = "Status equipement"
        .Body = "Hierbij de laatste update,"
        .attachments.Add "F:\Klanten\Equipment Overviews\" & Range("BEDRIJFSINFO!A2").Value & "_" & aanduiding & ".pdf"
        .display
        '.send  'ipv .display om direct te verzenden
      End With
End Sub
 
Ik zie er niets ergs in.
Gewoon testen.
 
Bij mij thuis werkt jouw code perfect, en zodra ik hem op mijn werk in het bestand zet krijg ik een foutmelding 1004 waarbij onderstaande regel geel wordt gemaakt.
De code is echt 100% gelijk. Ik heb hem gewoon CTRL-C, CTRL-V ingevoerd vanaf dit forum, waarbij hij dus alleen thuis werkt.

Code: 
.Cells(1).Resize(.Cells(1).Value, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
 
Wat is het getal in A1?
Versieverschil Excel 2003 (werk) → 2007 of hoger (thuis)?
 
Beiden 2013 NL.
Ook de info in A1 is gelijk bij hetzelfde aantal regels.
Heel vaag. Ik ga morgen het werkbestand mee naar huis nemen en dan onder m`n eigen Excel opstarten.
Kijken wat het kan zijn.
 
Heb je de bladen verwisselt?
Noem de bladen in de code bij hun naam.
Bv. Sheet(1) wordt sheet("Bladnaam").
 
Nee, dat is allemaal gelijk.
Functie 'Sheet' wordt ook niet gebruikt in de foute regel, maar begrijp dus dat met 'With Sheets(1)' verwezen wordt naar de foute regel?
Thuis heb ik btw windows 8 en op het werk windows 7.
 
Laatst bewerkt:
Windows versie maakt niet uit.
Er wordt met de punten voor cells → .cells verwezen naar Sheet(1).
Als dit blad verwisselt is, dan is Sheet(1) sheet(2) geworden.
Als dat blad leeg is geeft dat de foutmelding.

Of als A1 van sheets(1) ook leeg is geeft dit dezelfde foutmelding.

Maar ja als beide bestanden identiek zijn, weet ik het ook niet meer.
 
Fout 1004 - Door de toepassing of door object gedefinieerde fout

Lees dat het idd een verwijzing is :S
 
Gebruik het bestand van thuis ook voor je werk.
Of zet het bestand van je werk zonder gevoelige info hier eens neer.
 
sph,

is het een optie om te printen naar b.v. PDF-Creator? Dan krijg je een PDF die ook uit 1 A4 bestaat.
 
@HSV: Thuis heb ik het bestand in gebruik zonder plaatjes etc. Misschien ligt het hieraan?
Helaas heb ik vandaag vergeten de sheet vanaf m`n werk mee te nemen. Dit moet ik morgen dus doen.
Dan zal ik hem hier uitgeplukt plaatsen.

@Haije: Ook een goed idee. Kan ik dit in een macro uitvoeren inclusief mailen zoals HSV voor mij geschreven heeft?
Edit: geinstalleerd; veel extra handelingen nodig. Werkt niet geheel automatisch in een macro.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan