Clever-Excel-Forum

Normale Version: Workbook von zuvor anwählen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
hi, ich habe ein Workbook: "AVK.XLSM". IN dieser wird folgendes Makro ausgeführt um die Datei zu speichern:
Sub Erstellen()
ActiveWorkbook.Save
For Each x In Workbooks
If x.Name = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" Then
    MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" & " schließen & erneut probieren!"
    GoTo weiter
    Exit For
End If
Next
 ActiveWorkbook.SaveCopyAs Filename:= _
 ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
 Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
Worksheets(2).Shapes("Picture 21").Visible = False
ActiveWorkbook.Save
Workbooks("AVK.XLSM").Activate
Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"
ActiveWorkbook.Save
Workbooks("das Workbook von zuvor").Activate
ActiveWorkbook.Close savechanges:=False
weiter:
End Sub

Es funktioniert soweit. Jedoch weiß ich nicht, wie ich das zuvor aktivierte Workbook wieder aktivieren kann? Denn dieses (von zuvor) soll am Ende geschlossen werden. Mit der Workbooks.activate-Methode geht das ja nicht, da ich den Namen des Workbooks nicht weiß -> https://msdn.microsoft.com/de-de/library...21837.aspx
Code:
Workbooks("& "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"").Activate
Hallo Julia,

Sub Erstellen()
Dim vorherWorkbook As Workbook
ActiveWorkbook.Save
For Each x In Workbooks
If x.Name = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" Then
    MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" & " schließen & erneut probieren!"
    GoTo weiter
    Exit For
End If
Next
 ActiveWorkbook.SaveCopyAs Filename:= _
 ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
 Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
Set vorherWorkbook = ActiveWorkbook
Worksheets(2).Shapes("Picture 21").Visible = False
ActiveWorkbook.Save
Workbooks("AVK.XLSM").Activate
Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"
ActiveWorkbook.Save
vorherWorkbook.Activate
ActiveWorkbook.Close savechanges:=False
weiter:
End Sub


Die rot markierten Stellen sind hizugekommen
Hallo Atilla,

ist die Variablenzuweisung nicht zu spät?

@o0Julia0o

Code:
If x.Name = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" Then
    MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" & " schließen & erneut probieren!"
    GoTo weiter
    Exit For
End If

das Exit For ist hier überflüssig, denn vorher gehst Du ja in die Sprungmarke ans Ende des Codes.
Hallo Stefan,

Kann man sicher schon mit dem Öffnen zuweisen, aber an der Stelle müsste auch gehen, denke ich.
Wenn ich das richtig sehe, fehlt zwischen zwei Zeilen und einer Zeile davor ein Unterstrich.

Bei Julia bin ich sowieso darauf eingestellt, dass es entweder nicht geht oder eine Zusatzfrage kommt. Wink
Hallo,


und ich würde das Ganze noch etwas verkürzen:

Code:
with sheets("Werte")
If x.Name = .Range("J1") & .Range("B2") & .Range("H2") & ".xlsm" Then
    MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & .Range("J1") & .Range("B2") & .Range("H2") & ".xlsm" & " schließen & erneut probieren!"
   bolFehler=true
End If
end with
if bolfehler then exit sub
Next
dann könnte das Weiter: u. Exit sub wegfallen
danke!
Hallo Julia,

ich habe Deinen Code mal etwas strukturiert:


Code:
Sub Erstellen()
Dim boVar As Boolean
Dim vorherWorkbook As Workbook
Dim strgName As String

strgName = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
ActiveWorkbook.Save

For Each x In Workbooks
 If x.Name = strgName Then
     MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & strgName & " schließen & erneut probieren!"
     boVar = True
     Exit For
 End If
Next

If boVar = False Then
  ActiveWorkbook.SaveCopyAs Filename:= _
  ActiveWorkbook.Path & "\" & strgName
  Set vorherWorkbook = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\" & strgName)

 Worksheets(2).Shapes("Picture 21").Visible = False 'wo befindet sich dieses Shape (welche Date welche Tabelle (Tabellenname))
 ActiveWorkbook.Save
 Workbooks("AVK.XLSM").Activate    'ist das die Datei, in der dieser Code steht??
'  Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"
 Sheets("Calc2").Range("BR4").FormulaLocal = "=" & Sheets("Calc2").Range("BR3").Value & "Calc2!$BR$5" 'in welcher datei und welche Tabelle passiert das
 ActiveWorkbook.Save

 vorherWorkbook.Close savechanges:=False
End If

End Sub

Im Code sind Kommentare mit teilweise Fragen.

Solltest Du nicht weiterkommen, wie wäre es, wenn Du mal aussagekräftige Beispieldateien einstellst.
Ich werd das Gefühl nicht los, dass das Alles viel einfacher lösbar ist.
i have to apologize, ich hatte erst noch einen Fehler wohl drinnen im Code. Daher der Text vom letzten Beitrag von mir. Den habe ich aber wieder herausgelöscht, da es doch funktionierte.

Trotzdem nochmal die Fragen ergänzt:
Code:
Sub Erstellen()
Dim boVar As Boolean
Dim vorherWorkbook As Workbook
Dim strgName As String

strgName = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
ActiveWorkbook.Save

For Each x In Workbooks
 If x.Name = strgName Then
     MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & strgName & " schließen & erneut probieren!"
     boVar = True
     Exit For
 End If
Next

If boVar = False Then
  ActiveWorkbook.SaveCopyAs Filename:= _
  ActiveWorkbook.Path & "\" & strgName
  Set vorherWorkbook = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\" & strgName)

 Worksheets(2).Shapes("Picture 21").Visible = False 'wo befindet sich dieses Shape (welche Date welche Tabelle (Tabellenname)) -> in der NichtAVK.xlsm im Tabellenblatt wo das Makro ausgeführt wird.
 ActiveWorkbook.Save
 Workbooks("AVK.XLSM").Activate    'ist das die Datei, in der dieser Code steht?? -> genau!
'  Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"
 Sheets("Calc2").Range("BR4").FormulaLocal = "=" & Sheets("Calc2").Range("BR3").Value & "Calc2!$BR$5" 'in welcher datei und welche Tabelle passiert das -> in der AVK.xlsm im Tabellenblatt Calc2
 ActiveWorkbook.Save

 vorherWorkbook.Close savechanges:=False
End If

End Sub

Und hier der Vollständigkeit halber, meine alte Frage, welche ja keine mehr ist, da der Code ja doch funktionierte:
:::BEGINN ALTES QUATSCH-PROBLEM:::
Es wir jedoch die blau markierte Zeile nicht ausgeführt in der AVK.xlsm(=Hauptdatei):
--------------------------------------------------------------
Sub Erstellen()
Dim vorherWorkbook As Workbook -> Variable vorherWorkbook wird erstellt. (AS Workbook?)
ActiveWorkbook.Save
For Each x In Workbooks
If x.Name = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" Then
   MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" & " schließen & erneut probieren!"
   GoTo weiter
   Exit For
End If
Next
ActiveWorkbook.SaveCopyAs Filename:= _
ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
Set vorherWorkbook = ActiveWorkbook -> die Variable vorherWorkbook wird mit dem Wert des aktiven Workbooks befüllt - also dem Nicht-AVK.xlsm-Workbook.
Worksheets(2).Shapes("Picture 21").Visible = False
ActiveWorkbook.Save
Workbooks("AVK.XLSM").Activate
Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"
ActiveWorkbook.Save
vorherWorkbook.Activate -> Jetzt wird die Variable vorherWorkbook aktiviert (wohl als Workbook, was wohl durch "As Workbook" mögilch ist.
ActiveWorkbook.Close savechanges:=False
weiter:
End Sub
(in Pink mal meine Anmerkungen, wie ich es verstehe). Also nach dem Code müsste die blaue Zeile ja ausgeführt werden, wenn ich ihn richtig verstanden habe. Das Picture wird auch im richtigen Workbook(=Nicht-AVK.xlsm) ausgeblendet.
--------------------------------------------------------------

Ich habe mal grün markiert, was in der AKV.xlsm(=Hauptdatei geschen soll) & schwarz belassen, was in der "& Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"-Datei geschen soll:
--------------------------------------------------------------
Sub Erstellen()
ActiveWorkbook.Save
For Each x In Workbooks
If x.Name = Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" Then
   MsgBox "Datei ist noch geöffnet! Bitte die Datei: " & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm" & " schließen & erneut probieren!"
   GoTo weiter
   Exit For
End If
Next
ActiveWorkbook.SaveCopyAs Filename:= _
ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & Worksheets("Werte").Range("J1").Value & Worksheets("Werte").Range("B2").Value & Worksheets("Werte").Range("H2").Value & ".xlsm"
Worksheets(2).Shapes("Picture 21").Visible = False
ActiveWorkbook.Save
Workbooks("AVK.XLSM").Activate
Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"
ActiveWorkbook.Save
Workbooks("das Workbook von zuvor").Activate

ActiveWorkbook.Close savechanges:=False
weiter:
End Sub
--------------------------------------------------------------
:::ENDE ALTES QUATSCH-PROBLEM:::


Und so viel einfacher wird es nicht gehen. Also der Sinn dahinter ist folgender. Ich erstelle eine Datei. Diese muß in der Hauptdatei(AVK) verknpüpft werden, damit bei Verknpüpfung steht: "OK" oder zumindest "Warnung! Werte, adie sich auf andere Arbeitsmappen beziehen, wurden nicht aktualisiert":
[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]
Wenn ich dieses "Quelle nicht gefunden" hätte, könnte ich mich in der AVK.xlsm nicht auf diese Datei beziehen. Oder beim einstellen des Dateinamens, würde Excel fragen, wo die Datei ist(per Dateibrowser). Die Dateien liegen aber immer im gleichen Verzeichnis wie die AVK.xlsm. Wenn ich es also so speicher wie jetzt und zwischendurch die gerade gespeicerte Datei per "Range("Calc2!BR4").FormulaLocal = "=" & Range("Calc2!BR3").Value & "Calc2!$BR$5"" von der AKV.xlsm aus "aufrufe" bzw. auf diese deute, dann wird die gewollte Verküpfung erstellt. Ich erhalte dann zwar kein "OK", jedoch ist das egal. Weil beim nächsten Bezug auf die Datei, wird ihr Pfad erkannt. Und dann auch ein Wert. Oder ich würde die AVK.xlsm öffnen & der letzte Bezug würde noch drinstehen, auch dann würde es in ein OK direkt gewandelt, da die gesamte Tabelle aktualisiert werden würde. Aber das ist auch egal, da wenn ich den Bezug brauche, dieser ja aktualisiert wird. Ich kann jetzt auch den Ordner mit der AVK.xlsm irgendo anders hin kopieren oder per USB-Stick mitnehmen und an einem anderen PC bearbeiten. Die Bezüge funktionieren immer, da Excel immer im gleichen Pfad guckt, wo die Hauptatei ist(selbst wenn in den Bezugsfeldern ein absoluter Pfad jedes Mal drinsteht - dieser ist aber je nach Nutzungsort(Speicherort) anders.).