Makro für Word

Dieses Thema Makro für Word im Forum "Windows XP Forum" wurde erstellt von PCDjoe, 12. März 2003.

Thema: Makro für Word Ola, ich bin am Knobeln und krieg nur eine halbfertige Lösung zustande. Vielleicht hat ja jemand eine Idee: Sub...

  1. Ola,

    ich bin am Knobeln und krieg nur eine halbfertige Lösung zustande. Vielleicht hat ja jemand eine Idee:


    Danke für die Anregungen
     
  2. Hi PCDjoe,

    eine kleine Anregung für dich ;D ;D ;D

    Der Auswahldialog ist von http://www.arstechnica.de/computer/msoffice/vba/vba0060.html

    Gruß Matjes :)

    Code:
    'Verzeichnis Wählen von [url]http://www.arstechnica.de/computer/msoffice/vba/vba0060.html[/url]
    ''' 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
      
        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 DokumenteAusVerzeichnisInDokument()
    'Soll alle Dokumente eines auszuwählenden Verzeichnisses in ein Dokument schreiben.
    'Das Verzeichnis soll aber nicht mit dem identisch sein, in dem das Dokument gespeichert ist.
    
    'Definition: nach welchen files gesucht werden soll
    Const c_Filenamen = *.xls
    
    Dim b_mitPfadangabe   'True= Dokument mit Pfadangabe , false=ohne
    Dim fs As FileSearch
    Dim i As Long
    Dim sPath As String, sname As String, s_tmp As String, sSuchpfad As String, sFilename As String
    
      ' Auswahl des Pfades
      sSuchpfad = VerzeichnisWählen
    
      'Wahl: Ausgabe mit Pfadnamen oder ohne
      ret = MsgBox(Wollen Sie die Ausgabe der Filenamen mit komplettem Pfad ?, _
            vbQuestion + vbYesNo)
      If ret = vbYes Then
        b_mitPfadangabe = True
      Else
        b_mitPfadangabe = False
      End If
      
      'Wahl: Filename
      sFilename = InputBox(Geben Sie bitte den Filenamen ein !, Eingabe Filname, *.xls)
    
      'Filename und Pfad des eigenen Dokuments, um in aus der Fileliste auszublenden
      sPath = ActiveDocument.Path 'Pfad des Dokuments
      sname = ActiveDocument.Name 'Name des Dokuments
        
      'Schreibmarke vorbereiten
      Selection.Collapse Direction:=wdCollapseEnd
      Selection.InsertAfter Text:=vbCrLf
      
      If Not b_mitPfadangabe Then
        Selection.InsertAfter Text:=sSuchpfad & vbCrLf
      End If
     
      'Filenamen aus dem Directory sSuchpfad auflisten
      Set fs = Application.FileSearch
      
      With fs
        .NewSearch
        .LookIn = sSuchpfad
        .FileName = sFilename
        If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
          For i = 1 To .FoundFiles.Count
            If .FoundFiles(i) <> (sPath & \ & sname) Then 'nicht aktives Dokument
              s_tmp = .FoundFiles(i)
              If b_mitPfadangabe Then
                Selection.InsertAfter Text:=s_tmp & vbCrLf
              Else
                Selection.InsertAfter Text:=vbTab & NurFilenamen(s_tmp) & vbCrLf
              End If
            End If
          Next i
        Else
          MsgBox Keine Dokumente gefunden
        End If
      End With
    End Sub
    Private Function NurFilenamen(s_vollstaendigerFilename As String) As String
    'schneidet die Pfadangaben aus einem String und gibt den Filenamen zurueck
    Dim p1 As Integer, p2 As Integer
    
      p2 = 0: p1 = 0
      Do
        p1 = InStr(p1 + 1, s_vollstaendigerFilename, \)
        If p1 <> 0 Then p2 = p1
      Loop While p1 <> 0
      NurFilenamen = Right(s_vollstaendigerFilename, Len(s_vollstaendigerFilename) - p2)
    End Function
    
     
Die Seite wird geladen...

Makro für Word - Ähnliche Themen

Forum Datum
Makro für bleibendes Datum einrichten Microsoft Office Suite 23. Mai 2011
benötige Hilfe für ein Excel 2007 Makro Windows XP Forum 26. Mai 2010
Makro für Excel erstellen Microsoft Office Suite 18. Juli 2008
Excel: Makros gültig für nahezu alle WS Microsoft Office Suite 17. Aug. 2006
ACDSee: Gibt es ein plugin für die Programmierung eines Makros(=Befehlskette)? Software: Empfehlungen, Gesuche & Problemlösungen 18. Juli 2005