Von Word aus mit VBA den Wert einer Zelle holen

[Heinz Ulm]

Hallo VBA-Freunde

ich komme gerade nicht weiter.

Mit dem Codeschnipsel

With WRD.Dialogs(wdDialogFileSaveAs)
    .Name = genPath & "\" & genZName
    .Show
  End With
WRD.Selection.TypeParagraph

konnte ich in meinem erstellten Word file die Funktion "Save as" ufrufen und den Pfad und Speichername vorschlagen.
das klappt auch auf meinem Rechner Office 16, wenn ich in den VBA-Optionen die Verweise zu WORD aktiviere.
Das führte aber bei dem Testlauf auf Office 10 zu einem Fehler, weil die DDL für Word 16 nicht bekannt war.
Ich müsste es nun anders herum versuchen,

ein Word-Makro "Speichern" aufbauen, dieses mit WRD.Run ("Speichern") aufrufen und so zu dem Befehl Speichern unter
zu kommen. Dazu müssen aber die Werte auf der der Tabelle "Start" aus der B8 = Pfad und der C8 = Speichername ausgelesen werden.

Wie kann das in das Makro
Sub speichern()
    Dim xlApp As Object
    
    Set xlApp  =  GetObject("Excel.Application")
   
    genpath = workbooks("offer_generator, 16.12.2016.xlsm").worksheet("Start").Range("B8").Value
    genname = workbooks("offer_generator, 16.12.2016.xlsm").worksheet("Start").Range("C8").Value
    ChangeFileOpenDirectory genpath
   
    ActiveDocument.SaveAs2 FileName:=genname, _
        FileFormat:=wdFormatXMLDocumentMacroEnabled, LockComments:=False, _
        Password:="", AddToRecentFiles:=True, WritePassword:="", _
        ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, CompatibilityMode:=15
End Sub

eingebaut werden. Momentan fliegt mir der Code schon bei "Dim xlApp As Object" mit "SUB ODER FUNKTION NICHT DEFINIERT" um die Ohren.
Wie schon gesagt die Verweise auf die einzelnen Applikationen kann ich nicht verwenden, da von Office10 bis Office16 alles verwendet wird.

Vielen Dank für eure Überlegungen.

Frohe Weihnachten wünscht euch
Heinz

[Kuwer]

Hallo Heinz,

so sollte es laufen (meine Ergänzungen sind rot gekennzeichnet):

Option Explicit

Sub speichern()
   Dim genname As String
   Dim genpath As String
   Dim xlApp As Object
   
   Set xlApp = GetObject(, "Excel.Application")
   genpath = xlApp.workbooks("offer_generator, 16.12.2016.xlsm").worksheets("Start").Range("B8").Value
   genname = xlApp.workbooks("offer_generator, 16.12.2016.xlsm").worksheets("Start").Range("C8").Value
   Set xlApp = Nothing
   
   ChangeFileOpenDirectory genpath
 
   ActiveDocument.SaveAs2 FileName:=genname, _
       FileFormat:=wdFormatXMLDocumentMacroEnabled, LockComments:=False, _
       Password:="", AddToRecentFiles:=True, WritePassword:="", _
       ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
       SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
       False, CompatibilityMode:=15
End Sub

Gruß Uwe

[Heinz Ulm]

Hallo Uwe,

vielen Dank, so geht es.

Jetzt habe ich nur noch einen kleinen Schönheitsfehler.

Der Code speichert ja gleich. Eigentlich sollte nur "Speichern unter" werden und der Dateiname vorgeschlagen werden.

Wie müsste der Speicherbefehl:

 ActiveDocument.SaveAs2 FileName:=genname, _
       FileFormat:=wdFormatXMLDocumentMacroEnabled, LockComments:=False, _
       Password:="", AddToRecentFiles:=True, WritePassword:="", _
       ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
       SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
       False, CompatibilityMode:=15

umgebaut werden dass nur "Speichern unter" aufgeht und der Pfad und der Name eingetragen sind.

Gruß Heinz

[Kuwer]

Hallo Heinz,

Wie müsste der Speicherbefehl ... umgebaut werden dass nur "Speichern unter" aufgeht und der Pfad und der Name eingetragen sind.

  With Dialogs(wdDialogFileSaveAs)
   .Name = genpath & genname
   .Format = Word.WdSaveFormat.wdFormatXMLDocumentMacroEnabled
   .Show
 End With

Gruß Uwe

[snb]

Code:

Sub M_snb()
   sn=getobject("offer_generator, 16.12.2016.xlsm").sheets("Start").Range("B8:C8")

   With Application.FileDialog(2)
      .InitialFileName = sn(1,1) & sn(1,2)
      If .Show Then ActiveDocument.SaveAs2 .SelectedItems(1), 13
   End With
End Sub

[Heinz Ulm]

Hallo ihr,

ich habe jetzt das Problem mit eurer Hilfe so gelöst:

Sub speichern()
Dim genname As String
Dim genpath As String
Dim xlApp As Object
Set xlApp = GetObject(, "Excel.Application")

genpath = xlApp.workbooks("offer_generator, 20.12.2016.xlsm").worksheets("Start").Range("B8").Value
genname = xlApp.workbooks("offer_generator, 20.12.2016.xlsm").worksheets("Start").Range("C8").Value
Set xlApp = Nothing
ChangeFileOpenDirectory genpath
With Dialogs(wdDialogFileSaveAs)
.Name = genname
.Show
End With

End Sub

Das läuft auch zufriedenstellend so.

Nur kam jetzt ein neues Problem dazu:

in xlApp.workbooks("offer_generator, 20.12.2016.xlsm").worksheets("Start").Range("B8").Value kann sich der Name der Exceldatei ändern, je nach dem zu
welchem Zeitpunkt der User die Excel-Datei speichert.

Beim Speichern wird aber der Pfad auf der Tabelle "Start" in die B8 (Pfad) C8 (Dateiname) zurückgeschrieben.

Wie bekomme ich nun xlApp.workbooks("offer_generator, 20.12.2016.xlsm"). flexibel.

Ich stehe gerade auf dem Schlauch und finde keine Lösung von Word aus.

[Heinz Ulm]

Hallo ihr,

ich habe das jetzt so gelöst:

In meinem Code in Excel:

    strParam = Worksheets("Start").Range("C8").Value

    WRD.Run ("Modul1.Makro1"), strParam

und als Speichercode in Word:

Public Sub speichern(strText As String)
Dim genname As String
Dim genpath As String
Dim xlApp As Object
Set xlApp = GetObject(, "Excel.Application")
genpath = xlApp.workbooks(strParam).worksheets("Start").Range("B8").Value
genname = xlApp.workbooks(strParam).worksheets("Start").Range("B19").Value
Set xlApp = Nothing
ChangeFileOpenDirectory genpath
With Dialogs(wdDialogFileSaveAs)
.Name = genname
.Show
End With

End Sub

und alles läuft jetzt wie gewünscht.
Frohe Weihnachten

Heinz