ziellink in der zelle drucken

Forumthread: ziellink in der zelle drucken

23.08.2005 22:25:15

mehmet

hallo forum,
ich habe folgendes makro erweitern koennen:
Const t = "Ziel drucken"


Sub Kontextmenü_Erweitern()
Call Kontext_Löschen
Dim Kontext As Object
Set Kontext = CommandBars("Cell").Controls.Add
Kontext.BeginGroup = True
With Kontext
.Caption = t
.OnAction = "MachEs1"
.FaceId = 4
End With
End Sub


Sub Kontext_Löschen()
On Error Resume Next
CommandBars("Cell").Controls(t).Delete
End Sub


Sub MachEs1()
MsgBox "Ziel in der Zelle wird gedruckt", vbExclamation
End Sub

jetzt moechte ich - nachdem ich mit dem kontextmenu
eine zelle angeklickt habe,
das ziel vom hyperlink ausdrücken.
geht das?
dank und gruss
mehmet

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: ziellink in der zelle drucken

23.08.2005 22:57:28

Josef
AW: ziellink in der zelle drucken

23.08.2005 23:10:13

mehmet
AW: ziellink in der zelle drucken

23.08.2005 23:53:06

Josef
Oder ab IE 5.0

24.08.2005 00:09:22

Josef
AW: Oder ab IE 5.0

24.08.2005 10:00:18

mehmet
AW: Oder ab IE 5.0

24.08.2005 16:30:56

Josef
hat geklappt, danke schön o.T.

24.08.2005 19:43:13

mehmet

AW: ziellink in der zelle drucken

23.08.2005 22:57:28

Josef

Hallo Mehmet!
ZB. so!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Const t As String = "Ziel drucken"

Sub Kontextmenü_Erweitern()
    Call Kontext_Löschen
    Dim Kontext As Object
    Set Kontext = CommandBars("Cell").Controls.Add
    Kontext.BeginGroup = True
    With Kontext
        .Caption = t
        .OnAction = "MachEs1"
        .FaceId = 4
    End With
End Sub

Sub Kontext_Löschen()
    On Error Resume Next
    CommandBars("Cell").Controls(t).Delete
End Sub

Sub MachEs1()
    Dim strFile As String

    If ActiveCell.Hyperlinks.Count > 0 Then
        strFile = ActiveCell.Hyperlinks(1).Address
        If Dir(strFile) <> "" Then ShellExecute 0, "Print", strFile, "", "", 0
    Else
        MsgBox "Kein gültiger Hyperlink!", 48, "Hinweis"
    End If
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!

AW: ziellink in der zelle drucken

23.08.2005 23:10:13

mehmet

hallo sepp,
erstmal herzlichen dank für dein vorschlag
also wenn ich es anwenden möchte, erscheint ein fehlermeldung:
laufzeitfehler '52':
dateiname oder -nummer falsch
und verweist im module auf


Sub maches1()
if dir(strfile)<> "" then ...
End Sub

gruss
mehmet

AW: ziellink in der zelle drucken

23.08.2005 23:53:06

Josef

Hallo Mehmet!
Mal geraten!
Die links gehen zu Webseiten und nicht zu Dateien auf deinem PC.
Dann vieleicht so!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
    szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Const t As String = "Ziel drucken"

Sub Kontextmenü_Erweitern()
    Dim Kontext As CommandBarButton
    Call Kontext_Löschen

    Set Kontext = CommandBars("Cell").Controls.Add(Type:=msoControlButton)
    With Kontext
        .BeginGroup = True
        .Caption = t
        .OnAction = "MachEs1"
        .FaceId = 4
    End With
    Set Kontext = Nothing
End Sub

Sub Kontext_Löschen()
    On Error Resume Next
    CommandBars("Cell").Reset
End Sub

Sub MachEs1()
    Dim strURL As String
    Dim strFile As String

    strFile = "C:\Windows\Temp\dummy.html"

    If ActiveCell.Hyperlinks.Count > 0 Then

        strURL = ActiveCell.Hyperlinks(1).Address

        URLDownloadToFile 0, strURL, strFile, 0, 0

        ShellExecute 0, "Print", strFile, "", "", 0

        Kill strFile

    Else

        MsgBox "Kein gültiger Hyperlink!", 48, "Hinweis"

    End If

End Sub

Gruß Sepp

Oder ab IE 5.0

24.08.2005 00:09:22

Josef

Geht's auch direkt!

Private Declare Sub Sleep Lib "Kernel32.dll" (ByVal SleepTime As Long)

Sub MachEs1()
    Dim strURL As String
    Dim IE_App As Object


    If ActiveCell.Hyperlinks.Count > 0 Then

        strURL = ActiveCell.Hyperlinks(1).Address

        Set IE_App = CreateObject("InternetExplorer.Application")

        IE_App.Navigate strURL 'IE Dokument öffnen

        While Not IE_App.ReadyState = 4 'IE Warten bis Dokument geladen
            Sleep 200
            DoEvents
        Wend

        IE_App.ExecWb 4, 2, 0, 0 'IE Drucken

        IE_App.Quit 'IE beenden

        Set IE_App = Nothing

    Else

        MsgBox "Kein gültiger Hyperlink!", 48, "Hinweis"

    End If

End Sub

Gruß Sepp

AW: Oder ab IE 5.0

24.08.2005 10:00:18

mehmet

hallo sepp
super, endlich funktioniert es
allerdings werde ich gefragt "kopie speichern unter"
statt das es ausdruckt
gruss
mehmet

AW: Oder ab IE 5.0

24.08.2005 16:30:56

Josef

Hallo Mehmet!
Sorry! Hab die Falschen Parameter erwischt;-(


IE_App.ExecWb 6, 2, 0, 0

muss es heißen!
Gruß Sepp

hat geklappt, danke schön o.T.

24.08.2005 19:43:13

mehmet

gruss

Beliebteste Forumthreads (12 Monate)

Forumthread: ziellink in der zelle drucken

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread