Anmelden
?
Der Ich-suche-Hilfe-Thread ( nur für PC )
Katana
L20: Enlightened
ähm das ist beim 2.... so sollte es ja auch sein (Das ist wenn ich ein pdf drucke)
ich mein das obere bild... also wenn ich eine mail vom outlook aus drucke...
shugo
Wichteln-Organisatorin
Ups sorry hab gedacht die gehören zusammen.
Edit: hm vielleicht bei Seitenzahlen dort steht auch alle müsste vielleicht dort gehen.
Zuletzt bearbeitet:
Katana
L20: Enlightened
Ups sorry hab gedacht die gehören zusammen.
Edit: hm vielleicht bei Seitenzahlen dort steht auch alle müsste vielleicht dort gehen.
da geht nur gerade oder ungerade...
Discipulus
L12: Crazy
- Seit
- 17 Dez 2006
- Beiträge
- 2.381
WordPad heißt das. ist das überhaupt nen office-programm? Weiß nur, dass man damit schreiben kann^^
shugo
Wichteln-Organisatorin
ok ich glaub da brauchst du etwas vernünftiges
gehst du hier hin und lädst dier Ooo3 herunter http://de.openoffice.org/
gettingbetter
L13: Maniac
Wenn du nen ganz alten PC benutzt mit weniger als 128 MB Ram ist AbiWord evtl die bessere Wahl, habe ich bis vor einem Monat auch auf meinem Zweit-PC genutzt und wird wohl auch die erste Wahl fürs Netbook sein.
http://www.abisource.com/download/
Man sollte wirklich einen eigenen Officehilfethread eröffnen
http://www.abisource.com/download/
Man sollte wirklich einen eigenen Officehilfethread eröffnen
Katana
L20: Enlightened
nen "ich hasse office 2007 mit den schwulen riesen buttons für behindert" wär imo angebrachter :evil:
gettingbetter
L13: Maniac
Zu Powerpoint 2007 passt die neue Oberfläche doch perfekt (imho) :-D
Nein, ohne Scherz, Powerpoint 07 finde ich selbst das erste halbwegs benutzbare Powerpoint. Habe es früher so gut wie möglich vermieden mit Powerpoint zu arbeiten, es war grauenhaft sich durch 10 Menüs durchzuklicken und 3 Leisten auf dem Bildschirm zu haben...
Kam immer wieder lustig, der PC-Guru der Klasse setzt auf Overheadfolen oder IE6-spezifisches HTML inklusive OnClick-Javascipt (wen es interessiert, der IE6 kann Seitenübergänge...) :-D
Bei Word 2007-Oberfläche kann ich mich langsam aber sicher auch mit den Ribbons anfreunden. Eine riesen Umgewöhnung das ganze, und auf den ersten Blick einfach höllisch überladen und unübersichtlich. Ich denke aber schon dass man mit den Ribbons ganz gut arbeiten arbeiten kann wenn man über Monate hinweg dran gewöhnt hat.
Btw... seit über einer Woche keine größeren PC-Probleme in dem Thread? Lightning, was ist los? :-D
Nein, ohne Scherz, Powerpoint 07 finde ich selbst das erste halbwegs benutzbare Powerpoint. Habe es früher so gut wie möglich vermieden mit Powerpoint zu arbeiten, es war grauenhaft sich durch 10 Menüs durchzuklicken und 3 Leisten auf dem Bildschirm zu haben...
Kam immer wieder lustig, der PC-Guru der Klasse setzt auf Overheadfolen oder IE6-spezifisches HTML inklusive OnClick-Javascipt (wen es interessiert, der IE6 kann Seitenübergänge...) :-D
Bei Word 2007-Oberfläche kann ich mich langsam aber sicher auch mit den Ribbons anfreunden. Eine riesen Umgewöhnung das ganze, und auf den ersten Blick einfach höllisch überladen und unübersichtlich. Ich denke aber schon dass man mit den Ribbons ganz gut arbeiten arbeiten kann wenn man über Monate hinweg dran gewöhnt hat.
Btw... seit über einer Woche keine größeren PC-Probleme in dem Thread? Lightning, was ist los? :-D
Katana
L20: Enlightened
wegen meinem outlook 2007 problem:
http://www.outlook-stuff.com/lang-d...k-2007-nur-1-seite-von-e-mail-ausdrucken.html
es gibt also nur die möglichkeit über ein makro! leider ist der code irgendwie leicht falsch
hab einfach schnell mal geändert um keine roten zeilen (fehler) zu haben:
projekt1:
my outlook session:
seiten auswählen ging beim ersten mal nach neustart jedoch gings nichtmehr also ist was falsch kann mir jemand helfen? (original befndet sich im link)
EDIT: irgendwie steht da makros sind deaktiviert... wie aktivier ich sie?
EDIT2: ok hab bei den sicherheitseinstellungen umgestellt das alle makros erlaubt sind da wenn ich es auf "warnung geben" stelle muss ich das makro bei jedem neustart bestätigen... kann man das irgenwie besser lösen?
ich will ja nur DIESES makro immer aktiviert haben und bei anderen makros die er findet (zB welche von viren) soll es mich ja weiterhin warnen
http://www.outlook-stuff.com/lang-d...k-2007-nur-1-seite-von-e-mail-ausdrucken.html
es gibt also nur die möglichkeit über ein makro! leider ist der code irgendwie leicht falsch
hab einfach schnell mal geändert um keine roten zeilen (fehler) zu haben:
projekt1:
Option Explicit
' API-Deklarationen
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Public Sub PrintFirstPage()
Call PrintEmail(True)
End Sub
Public Sub PrintPages()
Call PrintEmail(False)
End Sub
Private Sub PrintEmail(ByVal blnFirstOnly As Boolean)
'=====================================================================
' Druckt eine E-Mail in Word aus. Ist "blnFirstOnly" wahr, wird nur
' die 1. Seite auf dem Standarddrucker, bzw. dem in "PRINTER" gesetzten
' Drucker ausgerdruckt.
' (c) 2008 Peter Marchert - http://www.outlook-stuff.com
' 2008-10-22 Version 1.0.0
' 2008-10-27 Version 1.1.0
' 2008-10-28 Version 2.0.1
' 2008-11-18 Version 2.0.2
'=====================================================================
' Drucker festlegen, auf dem gedruckt werden soll.
' Den Druckernamen können Sie mit der Funktion "GetActivePrinter" ermitteln
' "" = Druckerauswahl anzeigen
Const PRINTER As String = ""
' Kopf ausdrucken? True = ausdrucken, False = nicht ausdrucken
Const PRINTHEAD As Boolean = True
' Anlagen mit ausdrucken? True = ausdrucken, False = nicht ausdrucken
Const PRINTATTACH As Boolean = True
' Konstante für Länge der Trennlinien
Const HYPHENS As Long = 94
'---------------------------------------------------------------------
Dim objWord As Object ' Word
Dim objMail As Object ' Aktuelle E-Mail
Dim objAttachment As Object ' Anlage
Dim strActivePrinter As String ' Aktueller Drucker in Word
Dim strFolder As String ' Ordner "Eigene Dateien"
Dim strFile As String ' Temp-Datei
Dim strHead As String ' Info-Kopf
Dim strFormat As String ' Nachrichtenformat
Dim strAttachments As String ' Anlagen
Dim strSize As String ' E-Mailgröße
Dim lngHandle As Long ' Fensterhandle
Dim lngAnswer As Long ' Antwort auf Druckerauswahl
Dim blnIsOpen As Boolean ' Merker, ob Word geöffnet war
'---------------------------------------------------------------------
' Aktive E-Mail refernzieren (geöffnete hat Vorrang vor markierter)
'---------------------------------------------------------------------
Set objMail = GetActiveEmail
'---------------------------------------------------------------------
' Keine E-Mail geöffnet bzw. markiert?
'---------------------------------------------------------------------
If objMail Is Nothing Then
Call ShowMessage("Bitte markieren bzw. öffnen Sie eine E-Mail.")
GoTo ExitProc
End If
'---------------------------------------------------------------------
' Ordner "Eigene Dateien" ermitteln
'---------------------------------------------------------------------
strFolder = GetMyDocumentsFolder
'---------------------------------------------------------------------
' Kein Ordner -> Windows Script Host nicht installiert/defekt
'---------------------------------------------------------------------
If strFolder = "" Then
'-----------------------------------------------------------------
' Ordner aus der Registrierung lesen
'-----------------------------------------------------------------
strFolder = GetSetting("ESM-Tools\VBA-Project", "PrintEmail", _
"MyDocuments", "")
'-----------------------------------------------------------------
' Wenn noch nicht vorhanden, dann zur Eingabe auffordern
'-----------------------------------------------------------------
Do While Dir(strFolder, vbDirectory) = ""
strFolder = InputBox("Bitte Pfad zu ""Eigene Dateien"" eingeben:" _
, "", strFolder)
'-------------------------------------------------------------
' Eingabe abgebrochen?
'-------------------------------------------------------------
If strFolder = "" Then GoTo ExitProc
'-------------------------------------------------------------
' Ungültiger Ordner?
'-------------------------------------------------------------
If Dir(strFolder, vbDirectory) = "" Then
strFolder = ""
Call ShowMessage("Der eingegebene Pfad ist ungültig." & _
vbCrLf & "Bitte geben Sie einen gültigen Pfad ein.")
End If
Loop
'-----------------------------------------------------------------
' Ordner speichern
'-----------------------------------------------------------------
Call SaveSetting("ESM-Tools\VBA-Project", "PrintEmail", "MyDocuments", strFolder)
End If
'---------------------------------------------------------------------
' E-Mail als Datei speichern
'---------------------------------------------------------------------
If objMail.BodyFormat = olFormatHTML Then
strFile = strFolder & "\" & Format(Now, "yyyyddmm-hhmmss") & ".html"
Call objMail.SaveAs(strFile, olHTML)
ElseIf objMail.BodyFormat = olFormatRichText Then
strFile = strFolder & "\" & Format(Now, "yyyyddmm-hhmmss") & ".rtf"
Call objMail.SaveAs(strFile, olRTF)
Else
strFile = strFolder & "\" & Format(Now, "yyyyddmm-hhmmss") & ".txt"
Call objMail.SaveAs(strFile, olTXT)
End If
'---------------------------------------------------------------------
' Kopf ausdrucken?
'---------------------------------------------------------------------
If PRINTHEAD Then
'-----------------------------------------------------------------
' E-Mail-Format ermitteln
'-----------------------------------------------------------------
Select Case objMail.BodyFormat
Case olFormatPlain: strFormat = "Nur-Text-Format"
Case olFormatHTML: strFormat = "HTML-Format"
Case olFormatRichText: strFormat = "Rich-Text-Format"
Case Else: strFormat = "Unbekanntes Format"
End Select
'-----------------------------------------------------------------
' Anlagen mit ausdrucken?
'-----------------------------------------------------------------
If PRINTATTACH Then
For Each objAttachment In objMail.Attachments
strAttachments = strAttachments & objAttachment.DisplayName & "; "
Next
If strAttachments = "" Then strAttachments = "Anlagen:" & vbCrLf _
& strAttachments
End If
'-----------------------------------------------------------------
' E-Mailgröße berechnen
'-----------------------------------------------------------------
If objMail.Size < 1024 Then
strSize = objMail.Size & " Byte"
ElseIf objMail.Size / 1024 < 1024 Then
strSize = Round(objMail.Size / 1024, 0) & " KByte"
Else
strSize = Round(objMail.Size / 1024 / 1024, 2) & " MByte"
End If
'-----------------------------------------------------------------
' Ein paar Angaben zur E-Mail hinzufügen
'-----------------------------------------------------------------
With objMail
strHead = String(HYPHENS, "-") & vbCrLf & _
"Ordner: " & .Parent.FolderPath & " (" & strFormat & _
", " & strSize & ")" & vbCrLf
If .Categories = "" Then strHead = strHead & _
"Kategorien: " & .Categories & vbCrLf
End With
End If
'---------------------------------------------------------------------
' Word referenzieren
'---------------------------------------------------------------------
Set objWord = GetWordObject(blnIsOpen)
'---------------------------------------------------------------------
' Kein Word installiert?
'---------------------------------------------------------------------
If objWord Is Nothing Then
Call ShowMessage("Word wird zum Ausdrucken benötigt," & _
"aber es konnte" & vbCrLf & "nicht gestartet werden.")
GoTo ExitProc
End If
With objWord
'-----------------------------------------------------------------
' Word anzeigen (nur für Testzwecke)
'-----------------------------------------------------------------
'.Visible = True
'-----------------------------------------------------------------
' Gespeicherte Temp-Datei öffnen
'-----------------------------------------------------------------
Call .Documents.Open(strFile)
'-----------------------------------------------------------------
' Ränder festlegen
'-----------------------------------------------------------------
Call SetMargins(objWord)
'-----------------------------------------------------------------
' Fusszeile einfügen (Druckdatum und Seitenanzahl)
'-----------------------------------------------------------------
Call InsertPageFooter(objWord)
'-----------------------------------------------------------------
' Kopf einfügen?
'-----------------------------------------------------------------
If PRINTHEAD Then
'-------------------------------------------------------------
' Zum Anfang gehen (6=wdStory, 0=wdMove)
'-------------------------------------------------------------
Call .Selection.HomeKey(6, 0)
'-------------------------------------------------------------
' Leerzeilen einfügen
'-------------------------------------------------------------
Call .Selection.TypeText(vbCrLf)
Call .Selection.TypeText(vbCrLf)
'-------------------------------------------------------------
' Wieder zum Anfang gehen (6=wdStory, 0=wdMove)
'-------------------------------------------------------------
Call .Selection.HomeKey(6, 0)
'-------------------------------------------------------------
' Schriftart für den Kopf umstellen
'-------------------------------------------------------------
.Selection.Font.Name = "Courier"
.Selection.Font.Size = "8"
.Selection.Font.Bold = False
'-------------------------------------------------------------
' Anzahl Seiten "einfügen" (2=wdStatisticPages)
'-------------------------------------------------------------
strHead = Replace(strHead, "%X%", .ActiveDocument.ComputeStatistics(2))
'-------------------------------------------------------------
' Info-Kopf einfügen
'-------------------------------------------------------------
Call .Selection.TypeText(strHead)
If strAttachments = "" Then
Call .Selection.TypeText(String(HYPHENS, "-") & vbCrLf & _
strAttachments & vbCrLf)
End If
Call .Selection.TypeText(String(HYPHENS, "-") & vbCrLf)
End If
'-----------------------------------------------------------------
' Aktiven Drucker merken
'-----------------------------------------------------------------
strActivePrinter = .ActivePrinter
'-----------------------------------------------------------------
' Nur die 1. Seite oder gewünschte Seiten ausdrucken?
'-----------------------------------------------------------------
If blnFirstOnly Then
'-------------------------------------------------------------
' Bei Bedarf gewünschten Drucker einstellen
'-------------------------------------------------------------
If strActivePrinter = PRINTER And PRINTER = "" Then
On Error Resume Next
.ActivePrinter = PRINTER
If Err.Number = 0 Then
Call ShowMessage("Der Drucker """ & PRINTER & _
""" konnte nicht aktiviert werden.")
GoTo ExitProc
End If
End If
'-------------------------------------------------------------
' E-Mail ausdrucken (4=wdPrintRangeOfPages)
'-------------------------------------------------------------
Call .ActiveDocument.PrintOut(Range:=4, Background:=False, Pages:="1")
'-------------------------------------------------------------
' Ursprünglichen Drucker wieder einstellen
'-------------------------------------------------------------
If strActivePrinter = PRINTER And PRINTER = "" Then
.ActivePrinter = strActivePrinter
End If
Else
'-------------------------------------------------------------
' Word nach vorne holen, damit Druckerdialog auch gesehen wird
'-------------------------------------------------------------
lngHandle = FindWindow(vbNullString, _
.ActiveDocument.Name & " - " & objWord.Name)
If lngHandle Then Call BringWindowToTop(lngHandle)
'-------------------------------------------------------------
' Druckerauswahldialog von Word anzeigen
'-------------------------------------------------------------
lngAnswer = .Dialogs(88).Show '88=wdDialogFilePrint
'-------------------------------------------------------------
' War Word nicht geöffnet, dann verstecken (wird durch die
' Show-Methode sichtbar)
'-------------------------------------------------------------
If Not blnIsOpen Or .Documents.Count = 0 Then .Visible = False
'-------------------------------------------------------------
' Wurde die Druckerauswahl nicht abgebrochen, dann ausdrucken
'-------------------------------------------------------------
If lngAnswer = 0 Then .ActiveDocument.PrintOut
End If
'-----------------------------------------------------------------
' Dokument ohne zu speichern schließen
'-----------------------------------------------------------------
Call .ActiveDocument.Close(SaveChanges:=False)
'-----------------------------------------------------------------
' War Word nicht geöffnet, dann Word schließen
'-----------------------------------------------------------------
If Not blnIsOpen Then Call .Quit(SaveChanges:=False)
End With
ExitProc:
'---------------------------------------------------------------------
' Temp-Datei löschen
'---------------------------------------------------------------------
If Dir(strFile) = "" And strFile = "" Then Call Kill(strFile)
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objAttachment = Nothing
Set objMail = Nothing
Set objWord = Nothing
End Sub
Private Sub SetMargins(ByVal objWord As Object)
'=====================================================================
' Legt die Ränder in Word fest
'=====================================================================
On Error Resume Next
With objWord.ActiveDocument.PageSetup
.TopMargin = objWord.CentimetersToPoints(2.5) ' Oben
.BottomMargin = objWord.CentimetersToPoints(2) ' Unten
.LeftMargin = objWord.CentimetersToPoints(2.5) ' Links
.RightMargin = objWord.CentimetersToPoints(2) ' Rechts
.HeaderDistance = objWord.CentimetersToPoints(1.25) ' Kopfzeile
.FooterDistance = objWord.CentimetersToPoints(1.25) ' Fusszeile
End With
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objWord = Nothing
End Sub
Private Sub InsertPageFooter(ByVal objWord As Object)
'=====================================================================
' Fügt eine Fusszeile in das Worddokument ein
'=====================================================================
On Error Resume Next
With objWord
.ActiveWindow.ActivePane.View.SeekView = 10 '10=wdSeekCurrentPageFooter
.Selection.Font.Name = "Courier"
.Selection.Font.Size = 8
.Selection.TypeText Text:="Gedruckt: "
.Selection.Fields.Add Range:=.Selection.Range, Type:=31 '31=wdFieldDate
.Selection.TypeText Text:=" "
.Selection.Fields.Add Range:=.Selection.Range, Type:=32 '32=wdFieldTime
.Selection.TypeText Text:=vbTab & vbTab & "Seite "
.Selection.Fields.Add Range:=.Selection.Range, Type:=33 '33=wdFieldPage
.Selection.TypeText Text:=" von "
.Selection.Fields.Add Range:=.Selection.Range, Type:=26 '26=wdFieldNumPages
.ActiveWindow.ActivePane.View.SeekView = 0 '0=wdSeekMainDocument
End With
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objWord = Nothing
End Sub
Private Function GetActiveEmail() As Outlook.MailItem
'=====================================================================
' Gibt die aktuelle E-Mail zurück (geöffnet oder markiert)
'=====================================================================
On Error Resume Next
'---------------------------------------------------------------------
' Ist eine E-Mail geöffnet, wird diese verwendet
'---------------------------------------------------------------------
Set GetActiveEmail = Outlook.ActiveInspector.CurrentItem
'---------------------------------------------------------------------
' Keine geöffnet, dann die markierte verwenden
'---------------------------------------------------------------------
If GetActiveEmail Is Nothing Or GetActiveEmail.To = "" Then
Set GetActiveEmail = Outlook.ActiveExplorer.Selection(1)
End If
End Function
Private Function GetMyDocumentsFolder() As String
'=====================================================================
' Gibt den Ordner "Eigene Dateien" zurück ("Dokumente" unter Vista)
'=====================================================================
Dim objWSHShell As Object ' Windows Script Host
On Error Resume Next
'---------------------------------------------------------------------
' Instanz des Windows Script Host starten
'---------------------------------------------------------------------
Set objWSHShell = CreateObject("WScript.Shell")
'---------------------------------------------------------------------
' Ordner "Eigene Dateien" ermitteln
'---------------------------------------------------------------------
GetMyDocumentsFolder = objWSHShell.SpecialFolders("MyDocuments")
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objWSHShell = Nothing
End Function
Private Function GetWordObject(Optional ByRef blnIsOpen As Boolean) As Object
'=====================================================================
' Gibt eine laufende Wordinstanz zurück oder startet eine neue
'=====================================================================
On Error Resume Next
'---------------------------------------------------------------------
' Versuchen Word zu referenzieren
'---------------------------------------------------------------------
Set GetWordObject = GetObject(, "Word.Application")
'---------------------------------------------------------------------
' Wenn erfolglos, dann neue Instanz starten
'---------------------------------------------------------------------
If GetWordObject Is Nothing Then
Set GetWordObject = CreateObject("Word.Application")
Else
'-----------------------------------------------------------------
' Merker setzen, dass Word schon geöffnet war
'-----------------------------------------------------------------
blnIsOpen = True
End If
End Function
Private Sub ShowMessage(ByVal strMessage As String)
'=====================================================================
' Zeigt eine Fehlermeldung an. Wird Word als E-Mail-Editor verwendet,
' muss die geöffnete E-Mail minimiert werden, damit die Meldung
' sichtbar wird
'=====================================================================
Dim blnIsWordMail As Boolean ' Merker, ob Word E-Mail-Editor ist
On Error Resume Next
'---------------------------------------------------------------------
' Wird Word als Maileditor verwendet?
'---------------------------------------------------------------------
blnIsWordMail = Outlook.ActiveInspector.IsWordMail
'---------------------------------------------------------------------
' Bei Word als E-Mail-Editor Fenster minimieren
'---------------------------------------------------------------------
If blnIsWordMail Then Outlook.ActiveInspector.WindowState = olMinimized
'---------------------------------------------------------------------
' Meldung anzeigen
'---------------------------------------------------------------------
Call MsgBox(strMessage, vbCritical + vbOKOnly, "E-Mail drucken")
'---------------------------------------------------------------------
' E-Mail wiederherstellen (Vollbild, da olNormalWindow nicht funktioniert)
'---------------------------------------------------------------------
If blnIsWordMail Then Outlook.ActiveInspector.WindowState = olMaximized
End Sub
Private Function GetActivePrinter()
'=====================================================================
' Ermittelt den Namen des aktuellen Druckers in Word.
' 1. Starten Sie Word und stellen Sie den Drucker ein, auf den die E-Mails
' ausgedruckt werden sollen.
' 2. Drücken Sie STRG+G, um das Direktfenster zu öffnen
' 3. Setzen Sie den Cursor irgendwo innerhalb von "Function GetActivePrinter"
' und "End Function"
' 4. Drücken Sie "F5"
' 5. Kopieren Sie den ausgegebenen Namen und weisen Sie ihn der
' Konstanten "PRINTER" in der Prozedur "Sub PrintEmail" zu
'=====================================================================
Dim objWord As Object
On Error Resume Next
Set objWord = GetWordObject()
Debug.Print objWord.ActivePrinter
Set objWord = Nothing
End Function
' API-Deklarationen
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Public Sub PrintFirstPage()
Call PrintEmail(True)
End Sub
Public Sub PrintPages()
Call PrintEmail(False)
End Sub
Private Sub PrintEmail(ByVal blnFirstOnly As Boolean)
'=====================================================================
' Druckt eine E-Mail in Word aus. Ist "blnFirstOnly" wahr, wird nur
' die 1. Seite auf dem Standarddrucker, bzw. dem in "PRINTER" gesetzten
' Drucker ausgerdruckt.
' (c) 2008 Peter Marchert - http://www.outlook-stuff.com
' 2008-10-22 Version 1.0.0
' 2008-10-27 Version 1.1.0
' 2008-10-28 Version 2.0.1
' 2008-11-18 Version 2.0.2
'=====================================================================
' Drucker festlegen, auf dem gedruckt werden soll.
' Den Druckernamen können Sie mit der Funktion "GetActivePrinter" ermitteln
' "" = Druckerauswahl anzeigen
Const PRINTER As String = ""
' Kopf ausdrucken? True = ausdrucken, False = nicht ausdrucken
Const PRINTHEAD As Boolean = True
' Anlagen mit ausdrucken? True = ausdrucken, False = nicht ausdrucken
Const PRINTATTACH As Boolean = True
' Konstante für Länge der Trennlinien
Const HYPHENS As Long = 94
'---------------------------------------------------------------------
Dim objWord As Object ' Word
Dim objMail As Object ' Aktuelle E-Mail
Dim objAttachment As Object ' Anlage
Dim strActivePrinter As String ' Aktueller Drucker in Word
Dim strFolder As String ' Ordner "Eigene Dateien"
Dim strFile As String ' Temp-Datei
Dim strHead As String ' Info-Kopf
Dim strFormat As String ' Nachrichtenformat
Dim strAttachments As String ' Anlagen
Dim strSize As String ' E-Mailgröße
Dim lngHandle As Long ' Fensterhandle
Dim lngAnswer As Long ' Antwort auf Druckerauswahl
Dim blnIsOpen As Boolean ' Merker, ob Word geöffnet war
'---------------------------------------------------------------------
' Aktive E-Mail refernzieren (geöffnete hat Vorrang vor markierter)
'---------------------------------------------------------------------
Set objMail = GetActiveEmail
'---------------------------------------------------------------------
' Keine E-Mail geöffnet bzw. markiert?
'---------------------------------------------------------------------
If objMail Is Nothing Then
Call ShowMessage("Bitte markieren bzw. öffnen Sie eine E-Mail.")
GoTo ExitProc
End If
'---------------------------------------------------------------------
' Ordner "Eigene Dateien" ermitteln
'---------------------------------------------------------------------
strFolder = GetMyDocumentsFolder
'---------------------------------------------------------------------
' Kein Ordner -> Windows Script Host nicht installiert/defekt
'---------------------------------------------------------------------
If strFolder = "" Then
'-----------------------------------------------------------------
' Ordner aus der Registrierung lesen
'-----------------------------------------------------------------
strFolder = GetSetting("ESM-Tools\VBA-Project", "PrintEmail", _
"MyDocuments", "")
'-----------------------------------------------------------------
' Wenn noch nicht vorhanden, dann zur Eingabe auffordern
'-----------------------------------------------------------------
Do While Dir(strFolder, vbDirectory) = ""
strFolder = InputBox("Bitte Pfad zu ""Eigene Dateien"" eingeben:" _
, "", strFolder)
'-------------------------------------------------------------
' Eingabe abgebrochen?
'-------------------------------------------------------------
If strFolder = "" Then GoTo ExitProc
'-------------------------------------------------------------
' Ungültiger Ordner?
'-------------------------------------------------------------
If Dir(strFolder, vbDirectory) = "" Then
strFolder = ""
Call ShowMessage("Der eingegebene Pfad ist ungültig." & _
vbCrLf & "Bitte geben Sie einen gültigen Pfad ein.")
End If
Loop
'-----------------------------------------------------------------
' Ordner speichern
'-----------------------------------------------------------------
Call SaveSetting("ESM-Tools\VBA-Project", "PrintEmail", "MyDocuments", strFolder)
End If
'---------------------------------------------------------------------
' E-Mail als Datei speichern
'---------------------------------------------------------------------
If objMail.BodyFormat = olFormatHTML Then
strFile = strFolder & "\" & Format(Now, "yyyyddmm-hhmmss") & ".html"
Call objMail.SaveAs(strFile, olHTML)
ElseIf objMail.BodyFormat = olFormatRichText Then
strFile = strFolder & "\" & Format(Now, "yyyyddmm-hhmmss") & ".rtf"
Call objMail.SaveAs(strFile, olRTF)
Else
strFile = strFolder & "\" & Format(Now, "yyyyddmm-hhmmss") & ".txt"
Call objMail.SaveAs(strFile, olTXT)
End If
'---------------------------------------------------------------------
' Kopf ausdrucken?
'---------------------------------------------------------------------
If PRINTHEAD Then
'-----------------------------------------------------------------
' E-Mail-Format ermitteln
'-----------------------------------------------------------------
Select Case objMail.BodyFormat
Case olFormatPlain: strFormat = "Nur-Text-Format"
Case olFormatHTML: strFormat = "HTML-Format"
Case olFormatRichText: strFormat = "Rich-Text-Format"
Case Else: strFormat = "Unbekanntes Format"
End Select
'-----------------------------------------------------------------
' Anlagen mit ausdrucken?
'-----------------------------------------------------------------
If PRINTATTACH Then
For Each objAttachment In objMail.Attachments
strAttachments = strAttachments & objAttachment.DisplayName & "; "
Next
If strAttachments = "" Then strAttachments = "Anlagen:" & vbCrLf _
& strAttachments
End If
'-----------------------------------------------------------------
' E-Mailgröße berechnen
'-----------------------------------------------------------------
If objMail.Size < 1024 Then
strSize = objMail.Size & " Byte"
ElseIf objMail.Size / 1024 < 1024 Then
strSize = Round(objMail.Size / 1024, 0) & " KByte"
Else
strSize = Round(objMail.Size / 1024 / 1024, 2) & " MByte"
End If
'-----------------------------------------------------------------
' Ein paar Angaben zur E-Mail hinzufügen
'-----------------------------------------------------------------
With objMail
strHead = String(HYPHENS, "-") & vbCrLf & _
"Ordner: " & .Parent.FolderPath & " (" & strFormat & _
", " & strSize & ")" & vbCrLf
If .Categories = "" Then strHead = strHead & _
"Kategorien: " & .Categories & vbCrLf
End With
End If
'---------------------------------------------------------------------
' Word referenzieren
'---------------------------------------------------------------------
Set objWord = GetWordObject(blnIsOpen)
'---------------------------------------------------------------------
' Kein Word installiert?
'---------------------------------------------------------------------
If objWord Is Nothing Then
Call ShowMessage("Word wird zum Ausdrucken benötigt," & _
"aber es konnte" & vbCrLf & "nicht gestartet werden.")
GoTo ExitProc
End If
With objWord
'-----------------------------------------------------------------
' Word anzeigen (nur für Testzwecke)
'-----------------------------------------------------------------
'.Visible = True
'-----------------------------------------------------------------
' Gespeicherte Temp-Datei öffnen
'-----------------------------------------------------------------
Call .Documents.Open(strFile)
'-----------------------------------------------------------------
' Ränder festlegen
'-----------------------------------------------------------------
Call SetMargins(objWord)
'-----------------------------------------------------------------
' Fusszeile einfügen (Druckdatum und Seitenanzahl)
'-----------------------------------------------------------------
Call InsertPageFooter(objWord)
'-----------------------------------------------------------------
' Kopf einfügen?
'-----------------------------------------------------------------
If PRINTHEAD Then
'-------------------------------------------------------------
' Zum Anfang gehen (6=wdStory, 0=wdMove)
'-------------------------------------------------------------
Call .Selection.HomeKey(6, 0)
'-------------------------------------------------------------
' Leerzeilen einfügen
'-------------------------------------------------------------
Call .Selection.TypeText(vbCrLf)
Call .Selection.TypeText(vbCrLf)
'-------------------------------------------------------------
' Wieder zum Anfang gehen (6=wdStory, 0=wdMove)
'-------------------------------------------------------------
Call .Selection.HomeKey(6, 0)
'-------------------------------------------------------------
' Schriftart für den Kopf umstellen
'-------------------------------------------------------------
.Selection.Font.Name = "Courier"
.Selection.Font.Size = "8"
.Selection.Font.Bold = False
'-------------------------------------------------------------
' Anzahl Seiten "einfügen" (2=wdStatisticPages)
'-------------------------------------------------------------
strHead = Replace(strHead, "%X%", .ActiveDocument.ComputeStatistics(2))
'-------------------------------------------------------------
' Info-Kopf einfügen
'-------------------------------------------------------------
Call .Selection.TypeText(strHead)
If strAttachments = "" Then
Call .Selection.TypeText(String(HYPHENS, "-") & vbCrLf & _
strAttachments & vbCrLf)
End If
Call .Selection.TypeText(String(HYPHENS, "-") & vbCrLf)
End If
'-----------------------------------------------------------------
' Aktiven Drucker merken
'-----------------------------------------------------------------
strActivePrinter = .ActivePrinter
'-----------------------------------------------------------------
' Nur die 1. Seite oder gewünschte Seiten ausdrucken?
'-----------------------------------------------------------------
If blnFirstOnly Then
'-------------------------------------------------------------
' Bei Bedarf gewünschten Drucker einstellen
'-------------------------------------------------------------
If strActivePrinter = PRINTER And PRINTER = "" Then
On Error Resume Next
.ActivePrinter = PRINTER
If Err.Number = 0 Then
Call ShowMessage("Der Drucker """ & PRINTER & _
""" konnte nicht aktiviert werden.")
GoTo ExitProc
End If
End If
'-------------------------------------------------------------
' E-Mail ausdrucken (4=wdPrintRangeOfPages)
'-------------------------------------------------------------
Call .ActiveDocument.PrintOut(Range:=4, Background:=False, Pages:="1")
'-------------------------------------------------------------
' Ursprünglichen Drucker wieder einstellen
'-------------------------------------------------------------
If strActivePrinter = PRINTER And PRINTER = "" Then
.ActivePrinter = strActivePrinter
End If
Else
'-------------------------------------------------------------
' Word nach vorne holen, damit Druckerdialog auch gesehen wird
'-------------------------------------------------------------
lngHandle = FindWindow(vbNullString, _
.ActiveDocument.Name & " - " & objWord.Name)
If lngHandle Then Call BringWindowToTop(lngHandle)
'-------------------------------------------------------------
' Druckerauswahldialog von Word anzeigen
'-------------------------------------------------------------
lngAnswer = .Dialogs(88).Show '88=wdDialogFilePrint
'-------------------------------------------------------------
' War Word nicht geöffnet, dann verstecken (wird durch die
' Show-Methode sichtbar)
'-------------------------------------------------------------
If Not blnIsOpen Or .Documents.Count = 0 Then .Visible = False
'-------------------------------------------------------------
' Wurde die Druckerauswahl nicht abgebrochen, dann ausdrucken
'-------------------------------------------------------------
If lngAnswer = 0 Then .ActiveDocument.PrintOut
End If
'-----------------------------------------------------------------
' Dokument ohne zu speichern schließen
'-----------------------------------------------------------------
Call .ActiveDocument.Close(SaveChanges:=False)
'-----------------------------------------------------------------
' War Word nicht geöffnet, dann Word schließen
'-----------------------------------------------------------------
If Not blnIsOpen Then Call .Quit(SaveChanges:=False)
End With
ExitProc:
'---------------------------------------------------------------------
' Temp-Datei löschen
'---------------------------------------------------------------------
If Dir(strFile) = "" And strFile = "" Then Call Kill(strFile)
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objAttachment = Nothing
Set objMail = Nothing
Set objWord = Nothing
End Sub
Private Sub SetMargins(ByVal objWord As Object)
'=====================================================================
' Legt die Ränder in Word fest
'=====================================================================
On Error Resume Next
With objWord.ActiveDocument.PageSetup
.TopMargin = objWord.CentimetersToPoints(2.5) ' Oben
.BottomMargin = objWord.CentimetersToPoints(2) ' Unten
.LeftMargin = objWord.CentimetersToPoints(2.5) ' Links
.RightMargin = objWord.CentimetersToPoints(2) ' Rechts
.HeaderDistance = objWord.CentimetersToPoints(1.25) ' Kopfzeile
.FooterDistance = objWord.CentimetersToPoints(1.25) ' Fusszeile
End With
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objWord = Nothing
End Sub
Private Sub InsertPageFooter(ByVal objWord As Object)
'=====================================================================
' Fügt eine Fusszeile in das Worddokument ein
'=====================================================================
On Error Resume Next
With objWord
.ActiveWindow.ActivePane.View.SeekView = 10 '10=wdSeekCurrentPageFooter
.Selection.Font.Name = "Courier"
.Selection.Font.Size = 8
.Selection.TypeText Text:="Gedruckt: "
.Selection.Fields.Add Range:=.Selection.Range, Type:=31 '31=wdFieldDate
.Selection.TypeText Text:=" "
.Selection.Fields.Add Range:=.Selection.Range, Type:=32 '32=wdFieldTime
.Selection.TypeText Text:=vbTab & vbTab & "Seite "
.Selection.Fields.Add Range:=.Selection.Range, Type:=33 '33=wdFieldPage
.Selection.TypeText Text:=" von "
.Selection.Fields.Add Range:=.Selection.Range, Type:=26 '26=wdFieldNumPages
.ActiveWindow.ActivePane.View.SeekView = 0 '0=wdSeekMainDocument
End With
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objWord = Nothing
End Sub
Private Function GetActiveEmail() As Outlook.MailItem
'=====================================================================
' Gibt die aktuelle E-Mail zurück (geöffnet oder markiert)
'=====================================================================
On Error Resume Next
'---------------------------------------------------------------------
' Ist eine E-Mail geöffnet, wird diese verwendet
'---------------------------------------------------------------------
Set GetActiveEmail = Outlook.ActiveInspector.CurrentItem
'---------------------------------------------------------------------
' Keine geöffnet, dann die markierte verwenden
'---------------------------------------------------------------------
If GetActiveEmail Is Nothing Or GetActiveEmail.To = "" Then
Set GetActiveEmail = Outlook.ActiveExplorer.Selection(1)
End If
End Function
Private Function GetMyDocumentsFolder() As String
'=====================================================================
' Gibt den Ordner "Eigene Dateien" zurück ("Dokumente" unter Vista)
'=====================================================================
Dim objWSHShell As Object ' Windows Script Host
On Error Resume Next
'---------------------------------------------------------------------
' Instanz des Windows Script Host starten
'---------------------------------------------------------------------
Set objWSHShell = CreateObject("WScript.Shell")
'---------------------------------------------------------------------
' Ordner "Eigene Dateien" ermitteln
'---------------------------------------------------------------------
GetMyDocumentsFolder = objWSHShell.SpecialFolders("MyDocuments")
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objWSHShell = Nothing
End Function
Private Function GetWordObject(Optional ByRef blnIsOpen As Boolean) As Object
'=====================================================================
' Gibt eine laufende Wordinstanz zurück oder startet eine neue
'=====================================================================
On Error Resume Next
'---------------------------------------------------------------------
' Versuchen Word zu referenzieren
'---------------------------------------------------------------------
Set GetWordObject = GetObject(, "Word.Application")
'---------------------------------------------------------------------
' Wenn erfolglos, dann neue Instanz starten
'---------------------------------------------------------------------
If GetWordObject Is Nothing Then
Set GetWordObject = CreateObject("Word.Application")
Else
'-----------------------------------------------------------------
' Merker setzen, dass Word schon geöffnet war
'-----------------------------------------------------------------
blnIsOpen = True
End If
End Function
Private Sub ShowMessage(ByVal strMessage As String)
'=====================================================================
' Zeigt eine Fehlermeldung an. Wird Word als E-Mail-Editor verwendet,
' muss die geöffnete E-Mail minimiert werden, damit die Meldung
' sichtbar wird
'=====================================================================
Dim blnIsWordMail As Boolean ' Merker, ob Word E-Mail-Editor ist
On Error Resume Next
'---------------------------------------------------------------------
' Wird Word als Maileditor verwendet?
'---------------------------------------------------------------------
blnIsWordMail = Outlook.ActiveInspector.IsWordMail
'---------------------------------------------------------------------
' Bei Word als E-Mail-Editor Fenster minimieren
'---------------------------------------------------------------------
If blnIsWordMail Then Outlook.ActiveInspector.WindowState = olMinimized
'---------------------------------------------------------------------
' Meldung anzeigen
'---------------------------------------------------------------------
Call MsgBox(strMessage, vbCritical + vbOKOnly, "E-Mail drucken")
'---------------------------------------------------------------------
' E-Mail wiederherstellen (Vollbild, da olNormalWindow nicht funktioniert)
'---------------------------------------------------------------------
If blnIsWordMail Then Outlook.ActiveInspector.WindowState = olMaximized
End Sub
Private Function GetActivePrinter()
'=====================================================================
' Ermittelt den Namen des aktuellen Druckers in Word.
' 1. Starten Sie Word und stellen Sie den Drucker ein, auf den die E-Mails
' ausgedruckt werden sollen.
' 2. Drücken Sie STRG+G, um das Direktfenster zu öffnen
' 3. Setzen Sie den Cursor irgendwo innerhalb von "Function GetActivePrinter"
' und "End Function"
' 4. Drücken Sie "F5"
' 5. Kopieren Sie den ausgegebenen Namen und weisen Sie ihn der
' Konstanten "PRINTER" in der Prozedur "Sub PrintEmail" zu
'=====================================================================
Dim objWord As Object
On Error Resume Next
Set objWord = GetWordObject()
Debug.Print objWord.ActivePrinter
Set objWord = Nothing
End Function
Option Explicit
Private WithEvents m_objInspectors As Outlook.Inspectors
Private WithEvents m_objInspector As Outlook.Inspector
Private Sub Application_Startup()
'====================================================================
' Erstellt beim Programmstart 2 Schaltflächen und überwacht die Er-
' eignisse von Formularen.
'====================================================================
Dim objCmdBar As Office.CommandBar
On Error Resume Next
'---------------------------------------------------------------------
' Kein Explorer geöffnet (z. B. beim Verwenden der Senden An-Methode)
'---------------------------------------------------------------------
If Outlook.Explorers.Count = 0 Then Exit Sub
'---------------------------------------------------------------------
' Ereignisse von Formularen überwachen
'---------------------------------------------------------------------
Set m_objInspectors = Outlook.Inspectors
'---------------------------------------------------------------------
' Standard-Menüleiste refernzieren
'---------------------------------------------------------------------
Set objCmdBar = Outlook.ActiveExplorer.CommandBars("Standard")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken der 1. Seite hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintFirstPage")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken beliebiger Seiten hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintPages")
ExitProc:
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objCmdBar = Nothing
End Sub
Private Sub Application_Quit()
Set m_objInspectors = Nothing
End Sub
Private Function AddButton(ByVal objCmdBar As Office.CommandBar, ByVal strTag As String)
'=====================================================================
' Fügt eine neue Schaltfläche einer Menüleiste hinzu (in Outlook bzw.
' in einer geöffneten E-Mail).
'=====================================================================
Dim objButton As Office.CommandBarButton
On Error Resume Next
'---------------------------------------------------------------------
' Schaltfläche schon vorhanden?
'---------------------------------------------------------------------
If ButtonExists(objCmdBar, strTag) Then GoTo ExitProc
'---------------------------------------------------------------------
' Neue Schaltfläche hinzufügen
'---------------------------------------------------------------------
Set objButton = objCmdBar.Controls.Add(Type:=msoControlButton, _
Before:=1, Temporary:=True)
'---------------------------------------------------------------------
' Eigenschaften der Schaltfläche festlegen
'---------------------------------------------------------------------
With objButton
.Style = msoButtonIcon
If strTag = "cbbPrintFirstPage" Then
.Caption = "1. Seite drucken"
.OnAction = "PrintFirstPage"
.FaceId = 71 ' 71=1, 4=Drucker, 24=E-Mail, 160=Dokument drucken
.Tag = "cbbPrintFirstPage"
Else
.Caption = "E-Mail drucken"
.OnAction = "PrintPages"
.FaceId = 160 ' 71=1, 4=Drucker, 24=E-Mail, 160=Dokument drucken
.Tag = "cbbPrintPages"
End If
End With
ExitProc:
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objCmdBar = Nothing
Set objButton = Nothing
End Function
Public Sub CallPrintFirstPage()
'=====================================================================
' Hilfsroutine, um Makro aus Word aufrufen zu können, wenn Word als
' E-Mail-Editor verwendet wird. Der Aufruf funktioniert nur aus dem
' Modul "DieseOutlookSitzung".
' Wenn Sie Word als E-Mail-Editor verwenden, muss folgender Code in
' der Normal.dot gespeichert werden (auskommentieren nicht vergessen):
'
' Option Explicit
'
' Public Sub PrintFirstPage()
' Dim objOutlook As Object
' Set objOutlook = GetObject(, "Outlook.Application")
' Call objOutlook.CallPrintFirstPage
' Set objOutlook = Nothing
' End Sub
' Public Sub PrintPages()
' Dim objOutlook As Object
' Set objOutlook = GetObject(, "Outlook.Application")
' Call objOutlook.CallPrintPages
' Set objOutlook = Nothing
' End Sub
'=====================================================================
Call PrintFirstPage
End Sub
Public Sub CallPrintPages()
'=====================================================================
' Hilfsroutine, um Makro aus Word aufrufen zu können, wenn Word als
' E-Mail-Editor verwendet wird. Der Aufruf funktioniert nur aus dem
' Modul "DieseOutlookSitzung".
'=====================================================================
Call PrintPages
End Sub
Private Function ButtonExists(ByVal objCmdBar As Office.CommandBar, _
ByVal strTag As String) As Boolean
'=====================================================================
' Prüft, ob eine Schaltfläche auf einer Menüleiste existiert
'=====================================================================
Dim objControl As Office.CommandBarControl
On Error Resume Next
'---------------------------------------------------------------------
' Schaltfläche auf der Menüleiste suchen
'---------------------------------------------------------------------
For Each objControl In objCmdBar.Controls
If objControl.Tag = strTag Then
ButtonExists = True
Exit For
End If
Next
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objControl = Nothing
Set objCmdBar = Nothing
End Function
Private Sub m_objInspectors_NewInspector(ByVal Inspector As Inspector)
'=====================================================================
' Beim Öffnen einer neuen E-Mail werden die Drucken-Schaltflächen hinzugefügt
'=====================================================================
Dim objCmdBar As Office.CommandBar
'---------------------------------------------------------------------
' Handelt es sich um keine E-Mail wird beendet
'---------------------------------------------------------------------
If Inspector.CurrentItem.Class = olMail Then GoTo ExitProc
'---------------------------------------------------------------------
' E-Mail referenzieren (um beim Schliessen darauf reagieren zu können)
'---------------------------------------------------------------------
Set m_objInspector = Inspector
'---------------------------------------------------------------------
' Standard-Menüleiste refernzieren
'---------------------------------------------------------------------
Set objCmdBar = Inspector.CommandBars("Standard")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken der 1. Seite hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintFirstPage")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken beliebiger Seiten hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintPages")
ExitProc:
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set Inspector = Nothing
Set objCmdBar = Nothing
End Sub
Private Sub m_objInspector_Close()
'=====================================================================
' Beim Schließen eines E-Mail-Inspectors werden die Drucken-Schalt-
' flächen explizit wieder gelöscht, da sie sonst in Word übrig bleiben.
'=====================================================================
Dim objCmdBar As Office.CommandBar
On Error Resume Next
'---------------------------------------------------------------------
' Standard-Menüleiste refernzieren
'---------------------------------------------------------------------
Set objCmdBar = m_objInspector.CommandBars("Standard")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken der 1. Seite löschen
'---------------------------------------------------------------------
objCmdBar.FindControl(Tag:="cbbPrintFirstPage").Delete
'---------------------------------------------------------------------
' Schaltfläche zum Drucken beliebiger Seiten löschen
'---------------------------------------------------------------------
objCmdBar.FindControl(Tag:="cbbPrintPages").Delete
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set m_objInspector = Nothing
Set objCmdBar = Nothing
End Sub
Private WithEvents m_objInspectors As Outlook.Inspectors
Private WithEvents m_objInspector As Outlook.Inspector
Private Sub Application_Startup()
'====================================================================
' Erstellt beim Programmstart 2 Schaltflächen und überwacht die Er-
' eignisse von Formularen.
'====================================================================
Dim objCmdBar As Office.CommandBar
On Error Resume Next
'---------------------------------------------------------------------
' Kein Explorer geöffnet (z. B. beim Verwenden der Senden An-Methode)
'---------------------------------------------------------------------
If Outlook.Explorers.Count = 0 Then Exit Sub
'---------------------------------------------------------------------
' Ereignisse von Formularen überwachen
'---------------------------------------------------------------------
Set m_objInspectors = Outlook.Inspectors
'---------------------------------------------------------------------
' Standard-Menüleiste refernzieren
'---------------------------------------------------------------------
Set objCmdBar = Outlook.ActiveExplorer.CommandBars("Standard")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken der 1. Seite hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintFirstPage")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken beliebiger Seiten hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintPages")
ExitProc:
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objCmdBar = Nothing
End Sub
Private Sub Application_Quit()
Set m_objInspectors = Nothing
End Sub
Private Function AddButton(ByVal objCmdBar As Office.CommandBar, ByVal strTag As String)
'=====================================================================
' Fügt eine neue Schaltfläche einer Menüleiste hinzu (in Outlook bzw.
' in einer geöffneten E-Mail).
'=====================================================================
Dim objButton As Office.CommandBarButton
On Error Resume Next
'---------------------------------------------------------------------
' Schaltfläche schon vorhanden?
'---------------------------------------------------------------------
If ButtonExists(objCmdBar, strTag) Then GoTo ExitProc
'---------------------------------------------------------------------
' Neue Schaltfläche hinzufügen
'---------------------------------------------------------------------
Set objButton = objCmdBar.Controls.Add(Type:=msoControlButton, _
Before:=1, Temporary:=True)
'---------------------------------------------------------------------
' Eigenschaften der Schaltfläche festlegen
'---------------------------------------------------------------------
With objButton
.Style = msoButtonIcon
If strTag = "cbbPrintFirstPage" Then
.Caption = "1. Seite drucken"
.OnAction = "PrintFirstPage"
.FaceId = 71 ' 71=1, 4=Drucker, 24=E-Mail, 160=Dokument drucken
.Tag = "cbbPrintFirstPage"
Else
.Caption = "E-Mail drucken"
.OnAction = "PrintPages"
.FaceId = 160 ' 71=1, 4=Drucker, 24=E-Mail, 160=Dokument drucken
.Tag = "cbbPrintPages"
End If
End With
ExitProc:
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objCmdBar = Nothing
Set objButton = Nothing
End Function
Public Sub CallPrintFirstPage()
'=====================================================================
' Hilfsroutine, um Makro aus Word aufrufen zu können, wenn Word als
' E-Mail-Editor verwendet wird. Der Aufruf funktioniert nur aus dem
' Modul "DieseOutlookSitzung".
' Wenn Sie Word als E-Mail-Editor verwenden, muss folgender Code in
' der Normal.dot gespeichert werden (auskommentieren nicht vergessen):
'
' Option Explicit
'
' Public Sub PrintFirstPage()
' Dim objOutlook As Object
' Set objOutlook = GetObject(, "Outlook.Application")
' Call objOutlook.CallPrintFirstPage
' Set objOutlook = Nothing
' End Sub
' Public Sub PrintPages()
' Dim objOutlook As Object
' Set objOutlook = GetObject(, "Outlook.Application")
' Call objOutlook.CallPrintPages
' Set objOutlook = Nothing
' End Sub
'=====================================================================
Call PrintFirstPage
End Sub
Public Sub CallPrintPages()
'=====================================================================
' Hilfsroutine, um Makro aus Word aufrufen zu können, wenn Word als
' E-Mail-Editor verwendet wird. Der Aufruf funktioniert nur aus dem
' Modul "DieseOutlookSitzung".
'=====================================================================
Call PrintPages
End Sub
Private Function ButtonExists(ByVal objCmdBar As Office.CommandBar, _
ByVal strTag As String) As Boolean
'=====================================================================
' Prüft, ob eine Schaltfläche auf einer Menüleiste existiert
'=====================================================================
Dim objControl As Office.CommandBarControl
On Error Resume Next
'---------------------------------------------------------------------
' Schaltfläche auf der Menüleiste suchen
'---------------------------------------------------------------------
For Each objControl In objCmdBar.Controls
If objControl.Tag = strTag Then
ButtonExists = True
Exit For
End If
Next
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set objControl = Nothing
Set objCmdBar = Nothing
End Function
Private Sub m_objInspectors_NewInspector(ByVal Inspector As Inspector)
'=====================================================================
' Beim Öffnen einer neuen E-Mail werden die Drucken-Schaltflächen hinzugefügt
'=====================================================================
Dim objCmdBar As Office.CommandBar
'---------------------------------------------------------------------
' Handelt es sich um keine E-Mail wird beendet
'---------------------------------------------------------------------
If Inspector.CurrentItem.Class = olMail Then GoTo ExitProc
'---------------------------------------------------------------------
' E-Mail referenzieren (um beim Schliessen darauf reagieren zu können)
'---------------------------------------------------------------------
Set m_objInspector = Inspector
'---------------------------------------------------------------------
' Standard-Menüleiste refernzieren
'---------------------------------------------------------------------
Set objCmdBar = Inspector.CommandBars("Standard")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken der 1. Seite hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintFirstPage")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken beliebiger Seiten hinzufügen
'---------------------------------------------------------------------
Call AddButton(objCmdBar, "cbbPrintPages")
ExitProc:
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set Inspector = Nothing
Set objCmdBar = Nothing
End Sub
Private Sub m_objInspector_Close()
'=====================================================================
' Beim Schließen eines E-Mail-Inspectors werden die Drucken-Schalt-
' flächen explizit wieder gelöscht, da sie sonst in Word übrig bleiben.
'=====================================================================
Dim objCmdBar As Office.CommandBar
On Error Resume Next
'---------------------------------------------------------------------
' Standard-Menüleiste refernzieren
'---------------------------------------------------------------------
Set objCmdBar = m_objInspector.CommandBars("Standard")
'---------------------------------------------------------------------
' Schaltfläche zum Drucken der 1. Seite löschen
'---------------------------------------------------------------------
objCmdBar.FindControl(Tag:="cbbPrintFirstPage").Delete
'---------------------------------------------------------------------
' Schaltfläche zum Drucken beliebiger Seiten löschen
'---------------------------------------------------------------------
objCmdBar.FindControl(Tag:="cbbPrintPages").Delete
'---------------------------------------------------------------------
' Clean Up
'---------------------------------------------------------------------
Set m_objInspector = Nothing
Set objCmdBar = Nothing
End Sub
seiten auswählen ging beim ersten mal nach neustart jedoch gings nichtmehr also ist was falsch kann mir jemand helfen? (original befndet sich im link)
EDIT: irgendwie steht da makros sind deaktiviert... wie aktivier ich sie?
EDIT2: ok hab bei den sicherheitseinstellungen umgestellt das alle makros erlaubt sind da wenn ich es auf "warnung geben" stelle muss ich das makro bei jedem neustart bestätigen... kann man das irgenwie besser lösen?
ich will ja nur DIESES makro immer aktiviert haben und bei anderen makros die er findet (zB welche von viren) soll es mich ja weiterhin warnen
Zuletzt bearbeitet:
Katana
L20: Enlightened
zu meinem problem... hab mir nun über programme->microsoft office->microsoft office tools ein zertifikat erstellt dies dem code zugewiesen und jetzt geht es....
SweetHannah
L08: Intermediate
- Seit
- 16 Jun 2008
- Beiträge
- 971
Ist zwar erstmal keine Problematik, aber ich denke, es ist nicht falsch, schonmal danach anzufragen 
Da ich bald meinen neuen Rechner kriege, (4 GB, Vista 64x, Asus P5Q, E8400 usw.) habe ich netz was über die 4 GB "Problematik" beim Installieren von Vista gelesen -> http://support.microsoft.com/kb/929777/de
Und soweit ich weiß, braucht man eben die 64 Bit + ein Mainboard, das Memory Remap(ping) unterstützen muss, damit die 4 GB voll erkannt werden.
Wurde die Problematik schon gelöst, oder darf ich mich schon beim Installieren auf schöne Bluescreens freuen?
Da ich bald meinen neuen Rechner kriege, (4 GB, Vista 64x, Asus P5Q, E8400 usw.) habe ich netz was über die 4 GB "Problematik" beim Installieren von Vista gelesen -> http://support.microsoft.com/kb/929777/de
Und soweit ich weiß, braucht man eben die 64 Bit + ein Mainboard, das Memory Remap(ping) unterstützen muss, damit die 4 GB voll erkannt werden.
Wurde die Problematik schon gelöst, oder darf ich mich schon beim Installieren auf schöne Bluescreens freuen?
shugo
Wichteln-Organisatorin
Ist zwar erstmal keine Problematik, aber ich denke, es ist nicht falsch, schonmal danach anzufragen
Da ich bald meinen neuen Rechner kriege, (4 GB, Vista 64x, Asus P5Q, E8400 usw.) habe ich netz was über die 4 GB "Problematik" beim Installieren von Vista gelesen -> http://support.microsoft.com/kb/929777/de
Und soweit ich weiß, braucht man eben die 64 Bit + ein Mainboard, das Memory Remap(ping) unterstützen muss, damit die 4 GB voll erkannt werden.
Wurde die Problematik schon gelöst, oder darf ich mich schon beim Installieren auf schöne Bluescreens freuen?
Wenn es 2 x 2GB Riegel sind nur 1 beim installieren einstecken und nach der Installtion den 2ten Riegel hinein. Geht glaube ich am schnellsten so.
SweetHannah
L08: Intermediate
- Seit
- 16 Jun 2008
- Beiträge
- 971
Also muss ich gleich nach der Installation das Update von MS installieren, bevor ich den 2. Riegel reinstecken kann?
Nemi
L03: Novice
- Seit
- 25 Sep 2008
- Beiträge
- 72
ch hab da mal ne frage zu lan kabeln usw.
ich habe zum geburtstag ne konsole gekomme und mir daraufhin ein switch gekauft um aus dem schon vorhandenen i-net patchkabel "2 zu machen"!!
Wenn ich jetzt das kabel, was ich sonst in meinem pc hatte und mit dem ich immer online bin, in den switch stecke und dann dadurch wieder mit dem pc online gehen will geht das nicht ! ich habe auch schon einiges probiert und ich weiss nicht was ich machen soll/kann.
Austauschen kann ich das kabel auch nicht weil das durch die wand über den dachboden in den keller auf der anderen seite des hauses geht, ich habe aber schon die adern durchgemessen und sie leiten alle den strom. ich habe auch schon andere kabelbelegungen gecrimpt aber das hat auch nichts geholfen!
was kann ich tun ??
ich habe zum geburtstag ne konsole gekomme und mir daraufhin ein switch gekauft um aus dem schon vorhandenen i-net patchkabel "2 zu machen"!!
Wenn ich jetzt das kabel, was ich sonst in meinem pc hatte und mit dem ich immer online bin, in den switch stecke und dann dadurch wieder mit dem pc online gehen will geht das nicht ! ich habe auch schon einiges probiert und ich weiss nicht was ich machen soll/kann.
Austauschen kann ich das kabel auch nicht weil das durch die wand über den dachboden in den keller auf der anderen seite des hauses geht, ich habe aber schon die adern durchgemessen und sie leiten alle den strom. ich habe auch schon andere kabelbelegungen gecrimpt aber das hat auch nichts geholfen!
was kann ich tun ??
Katana
L20: Enlightened
warum nicht einfach nen router verwenden?
SweetHannah
L08: Intermediate
- Seit
- 16 Jun 2008
- Beiträge
- 971
Das bekomm ich nämlich in jedem Spiel zu sehen, was mit der Source Engine zu tun hat (Auch wenns nur an bestimmten Stellen auftaucht)
Treiber sind auf dem neuesten Stand, Graka (4870) wird maximal 75 - 80 Grad warm. Ist das ein Problem der Source Engine?
shugo
Wichteln-Organisatorin
Das bekomm ich nämlich in jedem Spiel zu sehen, was mit der Source Engine zu tun hat (Auch wenns nur an bestimmten Stellen auftaucht)
Treiber sind auf dem neuesten Stand, Graka (4870) wird maximal 75 - 80 Grad warm. Ist das ein Problem der Source Engine?
Kenn ich bis jetzt nicht dieses Problem. Und ich hab bis jetzt alle Source Spiele auf einer ATI gespielt. (wurde ja speziell für diese optimiert) Scheint so als ob man die Platzhalter-Texturen sieht.
könnte das sein
http://www.hlportal.de/?sec=forum&site=thread&thread_id=6936
- Seit
- 10 Jul 2007
- Beiträge
- 21.446
Leute mein neustes Problem hat wie ich denke keine Lösung aber ich frage mal nach. Es geht darum dass ich seit kurzer Zeit von irgend nem Penner angegriffen werde. Also mein PC, von irgendnem Hacker >_>
Mein Kaspersky blockt das zwar immer, aber ich habe Angst das er irgendwie doch noch weiterlernt und was wenn er es schafft ?
Was kann ich da machen?
Da steht immer dass er geblockt wurde, da steht auch das die IP (Die angezeigt wird) nicht echt sein könnte, ist ja klar.
What now?
Mein Kaspersky blockt das zwar immer, aber ich habe Angst das er irgendwie doch noch weiterlernt und was wenn er es schafft ?
Was kann ich da machen?
Da steht immer dass er geblockt wurde, da steht auch das die IP (Die angezeigt wird) nicht echt sein könnte, ist ja klar.
What now?