Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
656to660
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
656to660
656to660
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

ziellink in der zelle drucken

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
Anzeige
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!


Anzeige
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
Anzeige
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
Anzeige
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

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige