Print button voor hyperlink

[Nickdude]

Ik denk dat het beter is vanuit deze verder te werken;
want dit werkte;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Foutafhandeling
If Not Intersect(Target, Range("E3:E1000")) Is Nothing Then
' in bovenstaande wordt de selectie gechecked, valt de
' verandering niet in de selectie, dan gebeurt er niets
Workbooks.Open FileName:=Cells(Target.Row, Target.Column - 1).Value
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Close False
End If
Exit Sub
Foutafhandeling:
End Sub

Enkel moet nu nog de map "Tekeningen" voor iedere link komen.

Nick

 

[snabbi]

Geplaatst door Nickdude
Ook dit wekr niet.
Ik weet dat de hyperlinks kloppen, want in bijvoorbeeld Cel D4 kan ik er gewoon op drukken. Ik heb deze hyperlink gemaakt m.b.v. een excel formule. De hyperlink verwijst naar Tekeningen/.......xls. Echter staat in de cel alleen ......xls.
Als ik de code als hierboven toepas, zie ik in cel A1 geen enkele hyperlink verschijnen.

Nick

Nou eigenlijk werkt het beter dan je denkt, want hier staat gelijk waarom het niet werkt. Wanneer de macro wordt toegepast zoekt hij dus niet in de map tekeningen, waardoor je die fout krijgt.

Geplaatst door Nickdude
Ik denk dat het beter is vanuit deze verder te werken;
want dit werkte;

[knip]

Enkel moet nu nog de map "Tekeningen" voor iedere link komen.

Nick

Oke, maar dan volgt hij niet feitelijk de link maar meer de inhoud van de cel. Dus waar je link naar naar verwijst, dat is niet belangrijk, de waarde van de cel is van belang:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Foutafhandeling
If Not Intersect(Target, Range("E3:E1000")) Is Nothing Then
' in bovenstaande wordt de selectie gechecked, valt de
' verandering niet in de selectie, dan gebeurt er niets
Workbooks.Open FileName:= "Tekeningen" + _
Cells(Target.Row, Target.Column - 1).Value
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Close False
End If
Exit Sub
Foutafhandeling:
End Sub

 

[Nickdude]

OK, ja het werkt en het is niet erg dat hij nu de naam volgt en niet de link, want de link is gemaakt door "Tekeningen" ervoor te doen.
De code is nog een beetje aangepast, want er moest nog een \ tussen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Foutafhandeling
If Not Intersect(Target, Range("E3:E1000")) Is Nothing Then
' in bovenstaande wordt de selectie gechecked, valt de
' verandering niet in de selectie, dan gebeurt er niets
Workbooks.Open FileName:= "Tekeningen\ + _
Cells(Target.Row, Target.Column - 1).Value
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Close False
End If
Exit Sub
Foutafhandeling:
End Sub

Iig heel erg bedankt. Alleen heb iknog 1 klein vraagje. Nu zijn alle bestand beveiligd en vraagt hij dus om het wachtwoord in te voeren of "Read only" te openen. Ik zou graag willen dat hij automatisch read only geopend wordt. Is dit te verwezelijken?

Nick

 

[Nickdude]

Probleem is al opgelost.
Het werkt nu helemaal!
Allen bedankt!!

 

[jheesterbeek]

plaats eens (een deel van) de file op het forum, dan kunnen we met je meekijken e je hopelijk beter advsieren.

 

[Nickdude]

Als ik zei: het is reeds opgelost, dus is niet meer nodig.
Daarnaast is het redelijk lastig om bestanden bij te voegen, aangezien ze voor commerciele doeleinden zijn en dus als het ware 'bedrijfsgeheim' zijn.

Nick