Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1228to1232
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
Inhaltsverzeichnis

Worddokument schreiben mit Auswahl des Zielordners

Worddokument schreiben mit Auswahl des Zielordners
Georg
Hallo,
ich brauche nochmals Eure Hilfe.
Damit ich von der statischen Verzeichnisauswahl im VBA-Code wegkomme benötige ich
eine Abfrage vom Ort, wo das Word-Dokument gespeichert werden soll (also das Zielverzeichnis).
Könnte mir dabei jemand behilflich sein.
Gruß
Georg
https://www.herber.de/bbs/user/76667.xls

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Worddokument schreiben mit Auswahl des Zielordners
18.09.2011 22:17:40
Josef

Hallo Georg,
das geht z. B. so.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
  Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) _
  As Long

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  Flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Public Const OFN_FILEMUSTEXIST As Long = &H1000&
Public Const OFN_HIDEREADONLY As Long = &H4&
Public Const OFN_PATHMUSTEXIST As Long = &H800&

Sub versuch()
  Dim appWord As Object
  Dim doc As Object
  Dim sCheck As String
  Dim strTmp As String
  Dim Filter As String, FileName As String
  Dim Flags As Long
  
  strTmp = "E:\Office\Word\" & Sheets("Eingabe").Range("B4").Value & "_" & Sheets("Eingabe").Range("B5").Value & ".doc" '"C:\Excel\Zeugnis_" & Sheets("Eingabe").Range("B4").Value & "_" & Sheets("Eingabe").Range("B5").Value & ".doc"
  
  
  
  Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
    OFN_PATHMUSTEXIST
  
  Filter = "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0) & _
    "Word Dokumente (*.doc, *.docx, *.dot, *.dotx)" & Chr$(0) & _
    "*.doc; *.docx; *.dot; *.dotx" & Chr$(0)
  
  
  Filter = Filter & Chr$(0)
  
  FileName = ShowSave(Filter, 2, Flags, Application.hWnd, strTmp)
  
  
  If FileName <> "" Then
    sCheck = Sheets("Eingabe").Range("B4").Value & Sheets("Eingabe").Range("B5").Value
    If sCheck = "" Then
      Beep
      MsgBox "Kein Vorname und Nachname eingegeben !!"
      Exit Sub
    End If
    
    Set appWord = CreateObject("Word.Application")
    Set doc = appWord.documents.Add
    appWord.Visible = True
    
    
    With ThisWorkbook.Sheets("Excel-Dokument")
      .Range(.PageSetup.PrintArea).Copy
    End With
    
    ' doc.Paragraphs(1).Range.PasteAndFormat (22) Versuch von Sepp
    doc.Paragraphs(1).Range.Paste
    
    Application.CutCopyMode = False
    
    doc.SaveAs FileName
    
    doc.Close False '*** das Dokument schließen ***
    appWord.Quit '*** Word beenden ***
  End If
  
  '*** Aufräumen ***
  Set appWord = Nothing
  Set doc = Nothing
End Sub


Public Function ShowSave(Filter As String, FilterIndex As Long, Flags As Long, _
    hWnd As Long, FileName As String) As String

  
  Dim Buffer As String
  Dim Result As Long
  Dim ComDlgOpenFileName As OPENFILENAME
  
  Buffer = FileName & String$(128 - Len(FileName), 0)
  
  With ComDlgOpenFileName
    .lStructSize = Len(ComDlgOpenFileName)
    .hwndOwner = hWnd
    .Flags = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST
    .nFilterIndex = FilterIndex
    .nMaxFile = Len(Buffer)
    .lpstrFile = Buffer
    .lpstrFilter = Filter
  End With
  
  Result = GetSaveFileName(ComDlgOpenFileName)
  
  If Result <> 0 Then
    ShowSave = Left$(ComDlgOpenFileName.lpstrFile, _
      InStr(ComDlgOpenFileName.lpstrFile, _
      Chr$(0)) - 1)
  End If
End Function



« Gruß Sepp »

Anzeige
AW: Worddokument schreiben mit Auswahl des Zielordners
18.09.2011 22:51:14
Georg
Hallo Sepp,
das Modul bleibt mit Fehler 438 (Objekt unterstützt diese Methode nicht) im VBA-Code hängen
und zwar bei Befehl:
FileName = ShowSave(Filter, 2, Flags, Application.hWnd, strTmp)
Kann es an meiner Office-Version liegen?
Gruß
Georg
AW: Worddokument schreiben mit Auswahl des Zielordners
18.09.2011 23:04:46
Nepumuk
Hallö,
ergänze die Deklarationen damit:

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"

Und ändere den Aufruf so:

Filename = ShowSave(Filter, 2, Flags, _
    FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption), strTmp)

Gruß
Nepumuk
Anzeige
AW: Worddokument schreiben mit Auswahl des Zielordners
18.09.2011 23:15:36
Georg
Hallo Nepumuk,
funktioniert nun einwandfrei. Vielen Dank.
Gruß
Georg
@Sepp
18.09.2011 23:25:15
Nepumuk
Servus Sepp,
Filter ist eine VB-Funktion. Den Namen solltes du nicht als Variablennamen benutzen. Nochmal so schlampige Variablendeklarationen gibt einen Eintrag im Muttiheft !!!
Ach ja nochwas. Chr ist eine Funktion, Chr$(0) kannst du auch die Konstante vbNullChar benutzen. Spart bestimmt ein paar Mikrosekunden. :-)
Gruß
Nepumuk
AW: @Sepp
19.09.2011 11:07:24
Josef

Hallo Max,
Bitte nicht der Mama sagen! Dafür werde ich einhunderttausend Mal in meine Exceltabelle schreiben -
"ich soll keinen Code mit schlampiger Variablendeklaration posten" (natürlich per VBA;-)) )

« Gruß Sepp »

Anzeige
AW: @Sepp
19.09.2011 18:52:06
Josef

Hallo Max,
Bitte nicht der Mama sagen! Dafür werde ich einhunderttausend Mal in meine Exceltabelle schreiben -
"ich soll keinen Code mit schlampiger Variablendeklaration posten" (natürlich per VBA;-)) )

« Gruß Sepp »

140 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige