Excel VBA Word Speichern unter

[Lysander]

Hallo.

Ich bin gerade dabei über Excel eine Word Datei zu bearbeiten. Also das Ziel ist, dass ich die Files, die ich brauche in Excel auswähle, dann eine Schaltfläche betätige und sich dann entsprechende Worddateien öffnen. Nun werden sie mit Daten der Excel befüllt, in der zuvor angegebenen Menge gedruckt und dann wieder, ohne zu speichern, geschlossen. Das funktioniert auch alles soweit einwandfrei. Nun soll aber die Möglichkeit bestehen, dass wenn man eine Checkbox aktiviert, die Worddatei manuell mit dem "speichern unter" Dialog gespeichert werden kann. Kann man diesen Dialog, also den Word speichern unter Dialog, über ein Makro in Excel starten? Das die Worddatei unter einem spezifischen und klar definiertem Namen und Pfad gespeichert wird habe ich hinbekommen, dies ist aber sehr ungünstig, da die Excel auf einem Server liegt und sich so der Zielspeicherort immer ändert, je nachdem, wer zugreift. Gibt es da eine Lösung? Den Dialog zu öffnen?   

Vielen Dank und viele Grüße,
Lysander.

---

If ActiveSheet.Shapes("Check Box 18").ControlFormat.Value = 1 Then
                With wordapp.ActiveDocument
                    Application.Dialogs(wdDialogFileSaveAs).Show
                End With
            End If


Im Moment habe ich das zu stehen, dabei öffnet er mir jedoch "Zelle formatieren" in Excel 

[00202]

Hallo,  

habe hier was komplettes rumliegen. Nimm dir einfach den Teil raus, den du brauchst:  

Code:

Option Explicit
Const wdDialogFileSaveAs As Long = 84
Dim blnTMP As Boolean
Public Sub Test()
    Dim objDocument As Object
    Dim objDialog As Object
    Dim objApp As Object
    Dim strTMP As String
    On Error GoTo Fin
    strTMP = "Testvariable"
    Set objApp = OffApp("Word")
    If Not objApp Is Nothing Then
        With objApp
            Set objDocument = .Documents.Add
            Set objDialog = objApp.Dialogs(wdDialogFileSaveAs)
            With objDialog
                .Name = "C:\Temp\" & strTMP
                If .Display = -1 Then
                    objDocument.SaveAs Filename:=.Name
                End If
                objDocument.Close
            End With
        End With
    Else
        MsgBox "Applikation nicht installiert!"
    End If
Fin:
    If Not objApp Is Nothing Then
        If blnTMP = True Then
            objApp.Quit
            blnTMP = False
        End If
    End If
    Set objDocument = Nothing
    Set objDialog = Nothing
    Set objApp = Nothing
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            blnTMP = True
            If blnVisible = True Then
                On Error Resume Next
                objApp.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function

Wenn du "Application.Dialogs...." schreibst ist hier natürlich die Excelinstanz gemeint. Du muss das auf Word ummünzen.

[Lysander]

Oh, vielen Dank! Ich werde sehen, dass ich da was raus bekomme 

[snb]

Es kann komplizierter, aber diese Code reicht:

Code:

Sub M_snb()
  With CreateObject("Word.document")
    .Windows(1).Visible = True
   
    .Application.FileDialog(2).Show
  End With
End Sub

NB. nur 2 ist getattet, msoFileDialogSaveAs nicht