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

File van hyperlincks maken

Status
Niet open voor verdere reacties.
A

Arnese

Gebruiker
Lid geworden
3 feb 2011
Berichten
47
Goedemorgen,

Om offertes te maken, werk ik met een excelbestand met artikelnummers en omschrijvringen.
Aan de artikelnummers zijn hyperlincks met technische fiches gekoppeld.
Bedoeling is dat na het opslaan van de offerte of bij klikken op de knop een PDF gemaakt wordt van alle technische fiches.
Iemand een idee?
 
Heb je hier iets aan?

Code: 
Sheets("Bladnaam").Range("te kopieren bereik").Select
mynumber = Format(Range("A1").Value) 'cel waar het offertenummer staat
myname = Format(Range("B1").Value) 'naam 
mydate = Format(Range("C1").Value) 'datum

Bestandsnaam = "Offerte" & "_" & mynumber & "_" & myname & "_" & mydate
Pad1 = "C:\Mapnaam\Bladnaam\"
If myFile <> "False" Then
        ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Pad1 & Bestandsnaam, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

MsgBox "PDF files zijn gemaakt."

Pad1 = "C:\Mapnaam\Bladnaam" moet natuurlijk Pad1 = "C:\Mapnaam" zijn
 
Laatst bewerkt:
Plaats een voorbeeld van zowel dat Excel bestand als 1 of meerdere van de bedoelde fiches.
 
Ik heb de code overgenomen aan aangepast maar kom niet tot een resultaat.
Wanneer voert hij dit uit?

Private Sub Worksheet_Activate()
Sheets("Bladnaam").Range("C5:C7").Select
mynumber = Format(Range("A1").Value)
myname = Format(Range("B1").Value)
mydate = Format(Range("C1").Value)

Bestandsnaam = "Offerte" & "_" & mynumber & "_" & myname & "_" & mydate
Pad1 = "N:\PRODUCT\ardo"
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Pad1 & Bestandsnaam, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

MsgBox "PDF files zijn gemaakt."
End Sub
 
Je wilt het achter een knop toch?
Dan moet je niet Worksheet_Activate() maar de naam en click event van de knop.
MyFile doet niks in die code.
Sluit tevens Pad1 af met een \ teken.
 
Laatst bewerkt:
Hoi,

In de code is "End If" weggevallen.

Als je deze gebruikt, werkt het dan wel?

Code: 
Private Sub Worksheet_Activate()
Sheets("Bladnaam").Range("C5:C7").Select
mynumber = Format(Range("A1").Value)
myname = Format(Range("B1").Value)
mydate = Format(Range("C1").Value)

Bestandsnaam = "Offerte" & "_" & mynumber & "_" & myname & "_" & mydate
Pad1 = "N:\PRODUCT\ardo"
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Pad1 & Bestandsnaam, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
[COLOR="#FF0000"]End If[/COLOR]
MsgBox "PDF files zijn gemaakt."
End Sub
 
En in je voorbeeld bestand zou dit

Code: 
mynumber = Format(Range("A1").Value)
myname = Format(Range("[COLOR="#FF0000"]B1[/COLOR]").Value)
mydate = Format(Range("[COLOR="#FF0000"]C1[/COLOR]").Value)


Dit moeten zijn:

Code: 
mynumber = Format(Range("A1").Value) 
myname = Format(Range("[COLOR="#FF0000"]A2[/COLOR]").Value)
mydate = Format(Range("[COLOR="#FF0000"]A3[/COLOR]").Value)
 
Code: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    For Each it In Blad1.Hyperlinks
       CreateObject("shell.application").Namespace(Replace(it.Address, Dir(it.Address), "")).Items.Item(Dir(it.Address)).InvokeVerb "print"
    Next
End Sub
 
Je moet ook het te kopieren bereik uitbreiden, want met het bereik C5:C7 krijg je in je opgeslagen bestand alleen:
5000000, 6000000 en 7000000

Zo zou het moeten werken:

Code: 
Private Sub Worksheet_Activate()
Sheets("Bladnaam").Range("[COLOR="#FF0000"]A1:C10[/COLOR]").Select
mynumber = Format(Range("A1").Value)
myname = Format(Range("[COLOR="#FF0000"]A2[/COLOR]").Value)
mydate = Format(Range("[COLOR="#FF0000"]A3[/COLOR]").Value)

Bestandsnaam = "Offerte" & "_" & mynumber & "_" & myname & "_" & mydate
Pad1 = "N:\PRODUCT\ardo[COLOR="#FF0000"]\[/COLOR]"
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Pad1 & Bestandsnaam, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
[COLOR="#FF0000"]End If[/COLOR]
MsgBox "PDF files zijn gemaakt."
End Sub
 
@JanBG

Als je toch gebruik maakt van de defaultwaarden van een methode kun je ze net zo goed weglaten:

Code: 
ActiveSheet.ExportAsFixedFormat 0,Pad1 & Bestandsnaam
 
@snb: je hebt gelijk :)

@Arnese, dan wordt het:

Code: 
Private Sub Worksheet_Activate()
Sheets("Bladnaam").Range("A1:C10").Select
mynumber = Format(Range("A1").Value)
myname = Format(Range("A2").Value)
mydate = Format(Range("A3").Value)

Bestandsnaam = "Offerte" & "_" & mynumber & "_" & myname & "_" & mydate
Pad1 = "N:\PRODUCT\ardo\"
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat 0, Pad1 & Bestandsnaam
End If
MsgBox "PDF files zijn gemaakt."
End Sub
 
Dag JanBG,

Bedankt, ik heb er vertrouwen in dat het werkt, maar momenteel nog niet bij mij.
Ik plak de code in ALT+F11 en ik sla de file op als excelwerkmap met macro's.

Hoe wordt de PDF file met hyperlincks dan gegenereerd? Bij het opnieuw opslaan van het document?
Kan je eventueel je bestand van mijn voorbeeld eens opladen? Mss doe ik iets verkeerd.
 
Ik blijf dezelfde foutmelding krijgen:


Sub Macro3()
Sheets("Bladnaam").Range("A1:C10").Select
mynumber = Format(Range("A1").Value)
myname = Format(Range("A2").Value)
mydate = Format(Range("A3").Value)

Bestandsnaam = "Offerte" & "_" & mynumber & "_" & myname & "_" & mydate
Pad1 = "N:\FS_PRODUCT\ardo"
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat 0, Pad1 & Bestandsnaam
End If
MsgBox "PDF files zijn gemaakt."
End Sub
 
Er ontbreekt een \ in je pad:

het moet zijn
Code: 
Pad1 = "N:\PRODUCT\ardo\"

dus een \ na ardo
 
Zie printscreen.
Zelfs met de aanpassing van Pad1 dezelfde foutmelding.
Wat doe ik verkeerd? :)
 
Dat komt omdat er er al een bestand bestaat met dezelfde naam.

Zonder ruis kan je het ook zo schrijven.
Code: 
Sub VenA()
  Pad = "N:\PRODUCT\ardo\"
  ActiveSheet.ExportAsFixedFormat 0, Pad & "Offerte" & "_" & Range("A1").Value & "_" & Range("A2").Value & "_" & Format(Range("A3").Value, "yyyymmdd")
End Sub

Het If gedeelte is zoals door edmoor al opgemerkt niet nodig. Format doet ook weinig zoals het gebruikt is.
 
Laatst bewerkt:
Nu werkt de code en hij maakt een PDF van het Excel bestand.
Wat ik eigenlijk wou bereiken is dat hij een PDF bestand maakt van de hyperlinks.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan