• 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.

pdf opslaan in Dir waar excel bestand staat

Status
Niet open voor verdere reacties.
F

FrankyG1

Gebruiker
Lid geworden
28 aug 2008
Berichten
17
Goedenavond,

Ik heb een vba vraag waar ik zelf niet helemaal achter kan komen, misschien kan het ook gewoon niet, maar kan ik me bijna niet voorstellen.
Is het mogelijk om een geëxporteerd pdf bestand op te slaan in Dir waar het excel werkmap staat, maar dan in aparte mappen obv \Jaar\Maand\en dan bestandsnaam (worksheet name) & datum.pdf

Graag zou ik ook willen dat deze mappen automatisch worden aangemaakt bij nieuwe maand en jaar.

Is dit mogelijk in vba?
 
Dat kan:
Code: 
Sub Export2PDF()
    pad = Split(ThisWorkbook.Path & "\" & Year(Date) & "\" & Month(Date), "\")
    On Error Resume Next
    For i = 0 To UBound(pad)
        uit = uit & "\" & pad(i)
        MkDir Mid(uit, 2)
    Next i
    On Error GoTo 0
    PDF = Mid(uit, 2) & "\" & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & Date
    ActiveSheet.ExportAsFixedFormat 0, PDF
End Sub
Denk er wel aan dat worksheet en werkmap twee verschillende dingen zijn.
De code gebruikt nu de naam van het document (werkmap) en niet de naam van het actieve werkblad (worksheet).
Ook wordt nu alleen het actieve werkblad naar PDF geëxporteerd en niet het hele document.
 
Laatst bewerkt:
Beste edmoor,

Super bedankt al voor jouw snelle reactie. Het lijkt goed te werken met het aanmaken van de mappen, waarvoor dank. wat ik echter alleen wil is dat het pdf bestand de naam van het werkblad heeft aangevuld met de datum (in dit geval daglijsten-datum.pdf) en dat de export automatisch word opgeslagen in dir van het actieve werkmap (zelfde map bedoel ik dan) en dan de volgende mappen daarin aanmaken "\naam van werkblad\jaar\maand\ en dan het bestand".

dit bestand moet vervolgens na exporteren bijgevoegd worden in een mail. Hieronder heb ik de vba maar even bijgevoegd, met hoe ik het al had (zal vast niet goed zijn omdat ik heel veel dingen zelf heb toegevoegd door middel van zoeken, plakken en proberen e.d.)

Code: 
Sub Rechthoek1_oud_klikken_daglijst()
    Application.ScreenUpdating = False

    Dim Nm As String
    Dim Rng As Range
    Dim hideRowsRange As Range, r As Long
    Dim OutApp As Object
    Dim OutMail As Object
        
    ActiveSheet.Unprotect password:=""
    
    Set Rng = Range("A1:J142")     
    Set hideRowsRange = Range("A4:A32")
    Set hideRowsRange1 = Range("B38:B48")
    Set hideRowsRange2 = Range("B50:B60")
    Set hideRowsRange3 = Range("B62:B72")
    Set hideRowsRange4 = Range("B74:B84")
    Set hideRowsRange5 = Range("B86:B96")
    Set hideRowsRange6 = Range("B98:B108")
    Set hideRowsRange7 = Range("B110:B120")
    Set hideRowsRange8 = Range("A125:A132")
    Set hideRowsRange9 = Range("A135:A142")
      
    For r = 1 To hideRowsRange.Rows.Count
        If Application.CountA(hideRowsRange.Rows(r)) = 0 Then hideRowsRange.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange1.Rows.Count
        If Application.CountA(hideRowsRange1.Rows(r)) = 0 Then hideRowsRange1.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange2.Rows.Count
        If Application.CountA(hideRowsRange2.Rows(r)) = 0 Then hideRowsRange2.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange3.Rows.Count
        If Application.CountA(hideRowsRange3.Rows(r)) = 0 Then hideRowsRange3.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange4.Rows.Count
        If Application.CountA(hideRowsRange4.Rows(r)) = 0 Then hideRowsRange4.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange5.Rows.Count
        If Application.CountA(hideRowsRange5.Rows(r)) = 0 Then hideRowsRange5.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange6.Rows.Count
        If Application.CountA(hideRowsRange6.Rows(r)) = 0 Then hideRowsRange6.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange7.Rows.Count
        If Application.CountA(hideRowsRange7.Rows(r)) = 0 Then hideRowsRange7.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange8.Rows.Count
        If Application.CountA(hideRowsRange8.Rows(r)) = 0 Then hideRowsRange8.Rows(r).EntireRow.Hidden = True
    Next
    For r = 1 To hideRowsRange9.Rows.Count
        If Application.CountA(hideRowsRange9.Rows(r)) = 0 Then hideRowsRange9.Rows(r).EntireRow.Hidden = True
    Next
      
    Nm = ActiveWorkbook.FullName
    Nm = Left(Nm, InStrRev(Nm, ".") - 1) & Format(Now, " dd-mm-yyyy") & ".pdf"
    
    Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nm, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False

    For r = 1 To hideRowsRange.Rows.Count
        If Application.CountA(hideRowsRange.Rows(r)) = 0 Then hideRowsRange.Rows(r).EntireRow.Hidden = False
    Next
           
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Daglijsten" & Format(Now, " dd-mm-yyyy")
        .Body = "Bij deze onze daglijsten van" & Format(Now, " dd-mm-yyyy") & vbCrLf & vbCrLf & vbCrLf & "Met vriendelijke groet," & vbCrLf & Application.UserName
        .Attachments.Add Nm
        .Send
    
    End With
  
  Rows.EntireRow.Hidden = False
   
   Antwoord = MsgBox("Het bestand is opgeslagen en verzonden via mail" & vbNewLine & "Zeker weten dat je de lijst nu wilt wissen voor morgen?", vbQuestion + vbOKCancel, "Is alles afgerond?")
If Antwoord = vbCancel Then Exit Sub
    
Range("A3:I32,B38:I48,B50:I60,B62:I72,B74:I84,B86:I96,B98:I108,B110:I120,A125:G131,A135:G142").Select
Selection.ClearContents
Range("A3").Select
ActiveSheet.Protect password:=""
Application.ScreenUpdating = True

End Sub

Bij mijn vba gebruikt hij overigens wel de naam van werkmap (i.p.v. naam werkblad wat ik eigenlijk wil) voor het pdf bestand, heb dit ook geprobeerd om aan te passen, maar krijg dit echter ook niet voor elkaar.
 
Laatst bewerkt:
Inmiddels werkt het opslaan als een zonnetje, waarvoor nogmaals heel veel dank edmoor.
Ik krijg nu echter enkel het bestand niet toegevoegd als bijlage aan de mail. Hoe krijg ik dit voor elkaar?

Dit is de vba welke ik nu gebruik voor dit stukje:
Code: 
pad = Split(ThisWorkbook.Path & "\Daglijsten\" & "\" & Year(Date) & "\" & Month(Date), "\")
    On Error Resume Next
    For i = 0 To UBound(pad)
        uit = uit & "\" & pad(i)
        MkDir Mid(uit, 2)
    Next i
    On Error GoTo 0
    PDF = Mid(uit, 2) & "\" & ActiveSheet.Name & " " & Date
    Rng.ExportAsFixedFormat 0, PDF
            
    For r = 1 To hideRowsRange.Rows.Count
        If Application.CountA(hideRowsRange.Rows(r)) = 0 Then hideRowsRange.Rows(r).EntireRow.Hidden = False
    Next
           
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Daglijsten" & Format(Now, " dd-mm-yyyy")
        .Body = "Bij deze onze daglijsten van" & Format(Now, " dd-mm-yyyy") & vbCrLf & vbCrLf & vbCrLf & "Met vriendelijke groet," & vbCrLf & Application.UserName
        .Attachments.Add PDF
        .Send
 
Laatst bewerkt:
Waarschijnlijk omdat de PDF variabele niet de extensie van het bestand bevat.
Maak er dus eens dit van:
Code: 
PDF = Mid(uit, 2) & "\" & ActiveSheet.Name & " " & Date[COLOR="#FF0000"] & ".pdf"[/COLOR]
 
Laatst bewerkt:
Het is nooit een goed idee gelijksoortige gegevens op te slaan in afzonderlijke werkbladen, bestanden, directories.
Stap af van het papieren archiefdenken en gebruik automatisering optimaal door een bestand een unieke, kenmerkende naam te geven (bijv. met dag, en/of maan en/of jaar). Gebruik vervolgens de zoek en filtermagelijkeheden van Excel om een bestand terug te vinden.
Daarna wordt de analyse van gegevens (waarvoor papier niet geschikt is) onmetelijk vereenvoudigd.
 
Laatst bewerkt:
Kijk nog eens in je VBA handboek:
Vermijd overbodige Objectvariabelen.
En de combinatie (rows(j).entirerow) is dubbel overbodig.

Hiervoor heb jij 40 VBA-regels nodig.
Code: 
Range("A4:A32,A125:A132,A135:A142").specialcells(4).entirerow.hidden=true
Range("B38:B48,B50:B60,B62:B72,B74:B84,B86:B96,B98:B108,B110:B120").specialcells(4).entirerow.hidden =true
 
Beste snb,

bedankt voor jouw update. ik had het inmiddels zelf ook weer aangepast naar een regel, omdat het andere er wel erg lang over doet inderdaad.
 
Eigenlijk heb ik nog twee vragen hierover.
1) het verbergen van de ranges werkt niet goed. Zodra ik de ranges samenvoeg in een regel dan werkt het niet goed, het werkt alleen als ik het zoals boven doe (alles apart). Hoe kan het dat dit met de vba van snb en met een samengevoegde range niet werkt? Hoe krijg ik dit wel voor elkaar?

2) De code voor het opslaan werkt super goed (het aanmaken van mappen op basis van jaar en maand en dan de bestanden hierin plaatsen) Echter zal dit bestand op een server komen, is zoiets dan ook mogelijk eigenlijk, dat het bestand op dezelfde wijze wordt opgeslagen?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan