Makro zum drucken der ersten Seite von Stck. 200 Word2007 Doc in einem Verz.

Dieses Thema Makro zum drucken der ersten Seite von Stck. 200 Word2007 Doc in einem Verz. im Forum "Windows XP Forum" wurde erstellt von Bendix67, 9. Aug. 2012.

Thema: Makro zum drucken der ersten Seite von Stck. 200 Word2007 Doc in einem Verz. Ich bin neu hier und hoffe das ich das hier im richtigen Forum poste! Sonst bitte Info. Ich suche ein Makro das...

  1. Ich bin neu hier und hoffe das ich das hier im richtigen Forum poste! Sonst bitte Info.

    Ich suche ein Makro das folgendes können sollte:
    in einem Verzeichniss liegen einige hundert Word 2007 Dokumente die jeweils eine unterschiedliche Anzahl von Seiten haben. Das Makro soll alle Word Dokumente in diesem Verzeichniss in Word 2007 aufrufen und jeweils NUR die erste Seite ausdrucken und danach automatisch zum nächsten Word Dokument gehen in diesem Verzeichniss und dort so weitermachen. Ich habe hier schon ein Makro gefunden das aber nur unter Word 2003 funktioniert. Einige der befehle werden leider in Word 2007 nicht mehr unterstützt :|. Kennt einer eine Lösung?

    Option Explicit
    '© 2003 Matthias Köhler, Matthias.Koehler.KOE@t-online.de


    ' Typdeklaration für API-Dialog->Verzeichnis auswählen'
    Private Type BrowseInfo
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type

    Private Declare Function SHGetPathFromIDList Lib shell32.dll (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Function SHBrowseForFolder Lib shell32.dll (lpBrowseInfo As BrowseInfo) As Long

    ' Ermittelt Verzeichnisnamen und zeigt Windows-Dialog an
    Public Function VerzeichnisWählen(Optional DialogTitel) As String
    Dim StrukturVerzeichnisInfo As BrowseInfo, ListenNr As Long, Pfad As String
    Dim hWndAccessApp As Long

    With StrukturVerzeichnisInfo
    .hOwner = hWndAccessApp
    .lpszTitle = IIf(IsMissing(DialogTitel), Verzeichnispfad auswählen, CStr(DialogTitel))
    .ulFlags = &H1-> BIF_RETURNONLYFSDIRS
    End With

    ListenNr = SHBrowseForFolder(StrukturVerzeichnisInfo)
    Pfad = Space$(512)

    If SHGetPathFromIDList(ByVal ListenNr, ByVal Pfad) Then VerzeichnisWählen = Left(Pfad, InStr(Pfad, vbNullChar) - 1)

    End Function



    Public Sub DokumenteAusVerzeichnis_1Seite_Drucken()
    'Makro zum Ausdrucken der ersten Seite aller *.doc-Files eines Directories
    'mit Auswahl des Pfades
    '(die Ausgabe des eigenen Dokumentes wird unterdrückt)

    Dim fs As FileSearch
    Dim i As Long
    Dim sSuchpfad As String
    Dim ret As Integer

    -> Auswahl des Pfades
    sSuchpfad = VerzeichnisWählen(Bitte wählen Sie das Verzeichnis)

    If sSuchpfad = Then
    ret = MsgBox(Es wurde kein Suchpfad eingegeben ! & vbCrLf & Der Makro wird beendet., _
    vbOKOnly + vbInformation, Kein Suchpfad ausgewählt)
    Else

    ->Filenamen aus dem Directory sPath auflisten
    Set fs = Application.FileSearch

    fs.NewSearch
    fs.LookIn = sSuchpfad
    fs.FileName = *.doc
    i = fs.Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending)
    If fs.FoundFiles.Count > 0 Then
    For i = 1 To fs.FoundFiles.Count
    ->nicht das eigene Dokument
    If fs.FoundFiles(i) <> (ThisDocument.FullName) Then
    Application.PrintOut FileName:=fs.FoundFiles(i), _
    Range:=wdPrintFromTo, From:=1, To:=1
    DoEvents
    End If
    Next i
    Else
    MsgBox Keine Dokumente gefunden
    End If
    End If
    End Sub
     
  2. Hallo Bendix67,

    dann versuchs mal so.

    Gruß Matjes :)

    Wichtig zu beachten ist der Hinweis am Anfang !!
    Code:
    Option Explicit
    ->fuer FSO muss im VB-Editor unter Extras->Verweise Microsoft Scripting Runtime angehakt sein
    
    'Typdeklaration für API-Dialog->Verzeichnis auswählen'
      Private Type BrowseInfo
        hOwner     As Long
        pidlRoot    As Long
        pszDisplayName As String
        lpszTitle    As String
        ulFlags     As Long
        lpfn      As Long
        lParam     As Long
        iImage     As Long
      End Type
    
      Private Declare Function SHGetPathFromIDList Lib shell32.dll (ByVal pidl As Long, ByVal pszPath As String) As Long
      Private Declare Function SHBrowseForFolder Lib shell32.dll (lpBrowseInfo As BrowseInfo) As Long
    
    ' Ermittelt Verzeichnisnamen und zeigt Windows-Dialog an
    Public Function VerzeichnisWählen(Optional DialogTitel) As String
      Dim StrukturVerzeichnisInfo As BrowseInfo, ListenNr As Long, Pfad As String
      Dim hWndAccessApp As Long
     
      With StrukturVerzeichnisInfo
        .hOwner = hWndAccessApp
        .lpszTitle = IIf(IsMissing(DialogTitel), Verzeichnispfad auswählen, CStr(DialogTitel))
        .ulFlags = &H1-> BIF_RETURNONLYFSDIRS
      End With
      
      ListenNr = SHBrowseForFolder(StrukturVerzeichnisInfo)
      Pfad = Space$(512)
      
      If SHGetPathFromIDList(ByVal ListenNr, ByVal Pfad) Then VerzeichnisWählen = Left(Pfad, InStr(Pfad, vbNullChar) - 1)
      
    End Function
    
    
    Sub Verz_Dateien_ersteSeiteDrucken()
     Dim sPfad As String, sDateiendung As String
     Dim f() As String, fCnt As Long, x As Long
     
    ->Dateiendung definieren'
     sDateiendung = .docx
    ->Pfad definieren
     sPfad = VerzeichnisWählen(Bitte wählen Sie das Verzeichnis)
     If sPfad =  Then MsgBox Es wurde kein Suchpfad eingegeben !: GoTo AUFRAEUMEN
     
    ->Filenamen mittels FileSystemObject besorgen
     fCnt = 0
     If Not FSO_Folder_List_Files(sPfad, sDateiendung, f(), fCnt) Then GoTo AUFRAEUMEN
     If fCnt = 0 Then MsgBox Keine entsprechende Datei im Verzeichnis.: GoTo AUFRAEUMEN
     
     For x = 1 To fCnt
      Call Datei_Oeffnen_ersteSeiteDrucken_Schliessen(f(x))
     Next
     
    AUFRAEUMEN:
    End Sub
    
    '**************************************************************************************************************
    Function Datei_Oeffnen_ersteSeiteDrucken_Schliessen(sDateiNameFull As String)
     Dim doc As Document
     
    ->Datei öffnen
     On Error Resume Next
     Set doc = Documents.Open(FileName:=sDateiNameFull)
     On Error GoTo 0
     If doc Is Nothing Then MsgBox Datei konnte nicht geöffnet werden. & vbCrLf & sDateiNameFull: GoTo AUFRAEUMEN
     
    ->erste Seite drucken
     doc.PrintOut Range:=wdPrintFromTo, From:=1, To:=1
     
    ->Datei schliessen
     doc.Close SaveChanges:=False
    AUFRAEUMEN:
     Set doc = Nothing
    End Function
    
    '**************************************************************************************************************
    Function FSO_Folder_List_Files(sPfad As String, sDateiendung As String, f() As String, fCnt As Long) As Boolean
    ->fuer FSO muss im VB-Editor unter Extras->Verweise Microsoft Scripting Runtime angehakt sein
     Dim oFso As FileSystemObject, oVerzeichnis As Folder, oFile As File
     
     FSO_Folder_List_Files = False
     
    ->FileSystemObject für den Zugriff auf Verzeichnis-Struktur erzeugen
     Set oFso = New Scripting.FileSystemObject
     
     On Error Resume Next
    ->Verzeichnis lesen
     Set oVerzeichnis = oFso.GetFolder(sPfad)
     If oVerzeichnis Is Nothing Then MsgBox Pfad nicht vorhanden:  & vbCrLf & sPfad: GoTo AUFRAEUMEN
     On Error GoTo 0
     
    ->Alle Filenamen speichern
     If oVerzeichnis.Files.Count > 0 Then
      ReDim f(1 To oVerzeichnis.Files.Count)
      fCnt = 0
      For Each oFile In oVerzeichnis.Files
      ->Nur Dateien mit entsprechender Dateiendung bearbeiten
       If (Right(oFile.Name, Len(sDateiendung)) = LCase(sDateiendung)) Then
        fCnt = fCnt + 1
        f(fCnt) = oFso.BuildPath(oVerzeichnis.Path, oFile.Name)
       End If
      Next
      ReDim Preserve f(1 To fCnt)
     End If
     
     FSO_Folder_List_Files = True
    AUFRAEUMEN:
     Set oFso = Nothing: Set oVerzeichnis = Nothing: Set oFile = Nothing
    End Function
     
Die Seite wird geladen...

Makro zum drucken der ersten Seite von Stck. 200 Word2007 Doc in einem Verz. - Ähnliche Themen

Forum Datum
Excel-Makro - Tabellenblatt ausdrucken Microsoft Office Suite 30. Jan. 2008
makro um liste zu drucken Microsoft Office Suite 13. Nov. 2006
Makro um aktuelle Seite zu drucken (Excel) Microsoft Office Suite 3. Okt. 2003
Excel VBA Makro zum suchen eines Textes und anschließend einen Breich zu kopieren Microsoft Office Suite 22. Jan. 2015
Word 2013 VBA: Makro aus einer anderen Datei aufrufen Microsoft Office Suite 16. Juni 2014