Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
712to716
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
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

PDF-druckt alle Seiten

PDF-druckt alle Seiten
03.01.2006 21:33:34
BEATE
Hallo Leute!
Hab heut´schon mal probiert, aber leider hat mir niemand geantwortet. Versuch jetzt nochmal mein Glück.
Hab folgendes Problem.
Hab mal von Nepumuk dankenswerter weise, diesen super Code bekommmen, mit dem man ein pdf drucken kann und der gewünschte Ordner und Dateiname aus den Zellen entnommen wird. Funktioniert auch super.
Leider ist aber das Problem, dass, obwohl das für Adobe untypisch ist, die gesamte Arbeitsmappe ausgedruckt. Ich möchte aber gezielt nur das Tablellenblatt ausdrucken in dem ich mich befinde.
Weiss jemand einen Rat?
Bin dankbar für jeden Hinweis
Grüße
BEATE
**********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
'Liest alle unter dem aktuell angemeldeten Benutzer
'installierten Drucker aus
'by Nepumuk
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" ( _
ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
Private 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 GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Const MAX_PATH = 260&
Private Const SW_MAXIMIZE = 3&
Private Const MAX_PRINTERS = 16
Private strPrinterNames(MAX_PRINTERS) As String
Private strPrinterDrivers(MAX_PRINTERS) As String
Private strPrinterPorts(MAX_PRINTERS) As String
Private intPrinterCount As Integer
Sub Start_Print()
'by Ramses
'Druckt die übergebene Tabelle als PDF-Datei
'in das aktuelle Verzeichnis wo die Mappe gespeichert ist
Call Print_to_PDF(ActiveSheet)
End Sub
Public Sub Print_to_PDF(tarWks As Worksheet)
'by Ramses
'*********************************
'Verweise setzen auf
'Microsoft Office 10.0 / 11.0 Object Library und
'Acrobat Distiller
'*********************************
'Zusätzlich wird das Klassenmodul classAcroDist benötigt
Dim myAdobeDist As classAcroDist 'see class module
Dim myWB As Workbook
Dim strFilename As String
Dim strFileToPrintPath As String
Dim DistInputPS As String
Dim DistOutputPDF As String
Dim DistJobOptions As String
Dim oldActivePrinter As String
Set myAdobeDist = New classAcroDist
'Distiller ausgeblendet startetn
myAdobeDist.myAdobeDist.bShowWindow = False
'Alle aktuellen Printjobs des Distillers stoppen
myAdobeDist.myAdobeDist.bSpoolJobs = False
'Alten Drucker aufnehmen
oldActivePrinter = Application.ActivePrinter
'Workbook zuweisen
Set myWB = Workbooks(tarWks.Parent.Name)
'Pfad der Mappe extrahieren
strFileToPrintPath = Worksheets("Planungskizze").Cells(2, 2).Text & "\"
'Dann wechsle vorher in den Pfad der Datei
ChDrive (Left(strFileToPrintPath, 2))
ChDir strFileToPrintPath
'Zur druckender: Mappenname_Tabelle1
strFilename = Worksheets("Planungskizze").Cells(2, 1).Text
'EXCEL kann nur PS-Files direkt drucken
'daher muss sowohl PS-File wie auch PDF-File definiert werden
DistInputPS = strFileToPrintPath & strFilename & ".ps"
DistOutputPDF = strFileToPrintPath & strFilename & ".pdf"
'Der Druckername wird automatisch ermittelt
'in der Funktion "Get_Adobe_Printer"
myWB.PrintOut ActivePrinter:=Get_Adobe_Printer, prtoFilename:=DistInputPS, PrintToFile:=True
'Dem Distiller das PS-File zum konvertieren übergeben
Call myAdobeDist.myAdobeDist.FileToPDF(DistInputPS, DistOutputPDF, DistJobOptions)
'Schauen wie lange er braucht
'und STatus OK meldet
Do While Not myAdobeDist.blnFinished
DoEvents
Loop
If myAdobeDist.blnFinished Then
MsgBox "DAS PDF WURDE FÜR DIE KRICKON GMBH ERFOLGREICH ERSTELLT"
Else
MsgBox "Fehler beim Druck in PDF Datei aufgetreten"
End If
Call Open_PDF(strFileToPrintPath, strFilename & ".pdf")
'Alten Drucker wieder herstellen
Application.ActivePrinter = oldActivePrinter
'Variablen leeren
Set myAdobeDist = Nothing
End Sub
Function Get_Adobe_Printer() As String
'Adobe Drucker bestimmen
Dim strBuffer As String
Dim intIndex As Integer
strBuffer = Space$(8192)
GetProfileString "PrinterPorts", vbNullString, "", strBuffer, Len(strBuffer)
prcGetPrinterNames strBuffer
prcGetPrinterPorts
For intIndex = 0 To intPrinterCount
If InStr(1, strPrinterNames(intIndex), "Adobe") > 0 Then
'Genaue Druckerbezeicnung übergeben
Get_Adobe_Printer = strPrinterNames(intIndex) & " auf " & strPrinterPorts(intIndex)
Exit For
End If
Next
End Function

Private Sub prcGetPrinterNames(ByVal strBuffer As String)
Dim intIndex As Integer
Dim strName As String
intPrinterCount = 0
Do
intIndex = InStr(strBuffer, Chr(0))
If intIndex > 0 Then
strName = Left$(strBuffer, intIndex - 1)
If Len(Trim$(strName)) > 0 Then
strPrinterNames(intPrinterCount) = Trim$(strName)
intPrinterCount = intPrinterCount + 1
End If
strBuffer = Mid$(strBuffer, intIndex + 1)
Else
If Len(Trim$(strBuffer)) > 0 Then
strPrinterNames(intPrinterCount) = Trim$(strBuffer)
intPrinterCount = intPrinterCount + 1
End If
strBuffer = ""
End If
Loop While (intIndex > 0) And (intPrinterCount < MAX_PRINTERS)
End Sub


Private Sub prcGetPrinterPorts()
Dim strBuffer As String
Dim intIndex As Integer
For intIndex = 0 To intPrinterCount - 1
strBuffer = Space$(1024)
Debug.Print GetProfileString("PrinterPorts", strPrinterNames(intIndex), "", strBuffer, Len(strBuffer))
GetProfileString "PrinterPorts", strPrinterNames(intIndex), "", strBuffer, Len(strBuffer)
prcGetDriverAndPort strBuffer, strPrinterPorts(intIndex)
Next
End Sub


Private Sub prcGetDriverAndPort(ByVal Buffer As String, PrinterPort As String)
Dim intDriver As Integer
Dim intPort As Integer
PrinterPort = ""
intDriver = InStr(Buffer, ",")
If intDriver > 0 Then
intPort = InStr(intDriver + 1, Buffer, ",")
If intPort > 0 Then
PrinterPort = Mid$(Buffer, intDriver + 1, intPort - intDriver - 1)
Debug.Print PrinterPort
End If
End If
End Sub

Sub Open_PDF(strPath As String, strFile As String)
'by Nepumuk
Dim strShortPath As String
strShortPath = Space(MAX_PATH)
GetShortPathName strPath & strFile, strShortPath, MAX_PATH
strShortPath = Left$(strShortPath, InStr(1, strShortPath, vbNullChar) - 1)
ShellExecute GetActiveWindow, "open", strShortPath, "", strPath, SW_MAXIMIZE
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: PDF-druckt alle Seiten
03.01.2006 21:57:20
Ramses
Hallo
mit welchem Code druckst du denn genau ?
Ein Teil zum drucken des Codes ist von mir, der andere von Nepumuk.
Du solltest sagen WELCHEN Teil du zum drucken verwendest.
Gruss Rainer
AW: PDF-druckt alle Seiten
03.01.2006 22:05:08
BEATE
Hallo Rainer!
Bin ich froh, dass Du Dich meldest.
Ich verwende Deinen Code. Das Makro wird mit Start_Print() gestartet.
Ich könnte mir vorstellen, dass da nur eine Kleinigkeit zu ändern ist, aber ich bekomme es einfach nicht hin.
Vielen Dank schon einmal für Deine Hilfe
Grüße
BEATE
AW: PDF-druckt alle Seiten
03.01.2006 22:12:57
Ramses
Hallo
Es gibt eigentlich keinen Grund warum die gesamte Mappe gedruckt werden soll.
Als Parameter wird NUR die gerade aktive Tabelle als Druckobject übergeben.
Die einzige Möglichkeit die ich sehe ist, dass eventuell alle Tabellen gruppiert sind.
Dann wird die ganze Mappe gedruckt.
Gruss Rainer
Anzeige
AW: PDF-druckt alle Seiten
03.01.2006 22:21:52
BEATE
Hallo Rainer !
Vielen Dank für Deine Antwort.
Nur zur Info: wo steht das explzit nur diese eine Tabelle gedruckt werden soll?
Kannst Du mir noch einen Hinweis geben, wie ich diese mögliche Gruppierung aufheben kann; obwohl ich nicht davon ausgehe, dass ich die Tabellen gruppiert habe, weil ich ja gar nicht weiß wie das geht.
Hoffe wirklich, dass das hinhaut, denn ich bin schon ganz verzweifelt, dass ständig alle Tabellen gedruckt werden.
Naja - vielen Dank trotzdem
Liebe Grüße
Christoph
AW: PDF-druckt alle Seiten
03.01.2006 22:28:31
Ramses
Hallo
Call Print_to_PDF(ActiveSheet)
"ActiveSheet" bezieht sich hier auf die gerade sichtbare Tabelle.
Dass die Tabellen gruppiert sind, siehst du in der Titelzeile an dem Zusatz "[Gruppe]"
Userbild
Wenn einige, oder alle, Tabellen gruppiert sind, klicke einfach eine andere Tabelle deiner Mappe an.
Gruss Rainer
AW: PDF-druckt alle Seiten
03.01.2006 22:39:26
BEATE
Hallo Rainer!
Vielen Dank für Deine Hilfe.
Wie gesagt, es war nichts gruppiert.
ICh hab das jetzt ausprobiert. Bei einer Tabelle ist das kein Problem. SObald ich eine neue danach einfüge und irgendwas hineinschreibe und das Makro zum Laufen bringe, werden beide Seiten ausgedruckt.
Vielleicht gibts ja doch noch eine Möglichkeit. Vielleicht kann ich irgendwo nochmal das Active sheet genau benamen und es muß dann wirklich nur diese Seite ausgedruckt werden.
Naja die Hoffnung stirbt zuletzt.
Grüße
BEATE
Anzeige
AW: PDF-druckt alle Seiten
03.01.2006 22:54:53
BEATE
Hallo Dieter!
Vielen Dank für Deinen Hinweis-hast du eine Idee wo und wie ich das einbauen könnte?
Grüße
BEATE
ich hab's
03.01.2006 23:26:37
DieterB
Hallo Beate,
hier die Änderungen, mit denen es bei mir funktioniert:
Dim ash As Worksheet
'Der Druckername wird automatisch ermittelt
'in der Funktion "Get_Adobe_Printer"
ash.PrintOut ActivePrinter:=Get_Adobe_Printer, prtoFilename:=DistInputPS, PrintToFile:=True
Alle im Makro: Public Sub Print_to_PDF(tarWks As Worksheet)
Das ash.PrintOut ersetzt das alte myWB.PrintOut
Kann aber sein, dass eine Fehlermeldung kommt (Schriften)
Ich habe jetzt in jedem Blatt einen Button erstellt, und
den Buttons das Makro Print_to_PDf zugewiesen.
Gruß DieterB
Anzeige
bei mir geht´s leider nicht
04.01.2006 08:43:45
BEATE
Hallo Dieter!
VIelen Dank für Deine Mühe.
Ich hab nun die von dir geschriebenen Codes eingefügt.
Bei mir macht es aber genau bei der neuen Zeile eine Fehlermeldung.
Mittlerweile stehen soviele Codes in diesem Makro, dass man schon gar nicht mehr weiß, was dazugehört und was nicht.
Kannst Du mir vielleicht genau Deinen Code schicken? vielleicht funktionierts ja dann.
Vielen Dank nochmals für Deine Hilfe.
Grüße
BEATE
Super es funktioniert
04.01.2006 09:37:55
BEATE
Hallo Dieter!
Es funktioniert!!!!! Vielen vielen Dank!!!
Du hast mir eine Kleinigkeit verschwiegen:
Set ash = ActiveSheet
deshalb hat es nicht funktioniert.
Vielen Dank - du hast meinen Tag gerettet!!!
LIEBE GRÜßE
BEATE
Anzeige
AW: Super es funktioniert
04.01.2006 09:41:50
DieterB
Sorry für die Verschwiegenheit.
Freut mich, dass es funktioniert.
Gruß DieterB

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige