Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1396to1400
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
Workbooks.Open öffnet Datei nicht
17.12.2014 15:24:28
Marcus
Hallo,
ich habe ein Problem bzgl. des Workbooks.open-Befehl...
Zuerst einmal die Randbedingungen...
Ich lege mittels eines eigens erstelltem Kontextmenü einen Bericht in einer Exceldatei an. Der Bericht kann eine *.pptx oder eine *.docx sein. Das funktioniert an sich.
Bei bestimmten Berichten muss ich aber eine Nummer aus einer anderen Excelliste raussuchen um den Berichtnamen mit der Nummer zu ergänzen. Um diese zu öffnen und zu durchsuchen nutze ich den Befehl Workbooks.Open.
So nun zu meinem Problem...
Zuerst hatte ich das Bericht anlegen über eine Dropdownliste ausgeführt. Wird in dieser Zelle der Begriff "Bericht erstellen" wird eine Userform gestartet die nähere Information abfragt und eben auch wenn benötigt diese oben genannte Nummer sucht und einfügt. In diesem Fall wird die Nummer-Liste wunderbar über den .Open-Befehl geöffnet.
In einem Verbesserungsschritt haben ich die Dropdownliste durch ein Kontextmenü bei Rechtsklick in eine leere Zelle ersetzt. Wenn hier dann "Bericht erstellen" gewählt wird, wird dieselbe Userform wie oben aufgerufen. Und Tada hier funktioniert der Workbooks.Open-Befehl nicht mehr.
Woran liegt das, dass ein und der selbe Code durch Aufrufen mittels DropDownListe funktioniert und bei Aufrufen durch das Kontextmenü nicht?
Ich hatte auch schon probiert den Teil des Codes, der die Liste öffnet in ein Modul auszulagern. Aber der Sachverhalt bleibt gleich.
Wer kann mir helfen?
Danke

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Workbooks.Open öffnet Datei nicht
17.12.2014 15:27:14
Rudi
Hallo,
Woran liegt das, dass ein und der selbe Code durch Aufrufen mittels DropDownListe funktioniert und bei Aufrufen durch das Kontextmenü nicht?
Wahrscheinlich am Code Zeile 42.
Gruß
Rudi

AW: Workbooks.Open öffnet Datei nicht
17.12.2014 19:11:20
Oberschlumpf
Hallo alle
mögliche Gedankengänge beim Fragenden:
"Ähh?...Hmm?...uih...Woher weiß n dieser Rudi, dass es an Codezeile 42 liegt?!!?....das versteh ich nicht....Rudi kennt meinen Code doch gaar nicht!!
GEDANKENBLITZ...ganz vielleicht...beim Fragenden
...Ahhhh!!!...Rudi meint das ironisch!...weil...wie soll mir jemand helfen, wenn ich sooo eigentlich gaaaar keine Infos verrate, wie z Bsp...ich könnt ja mal den Code zeigen...oder...uihuihuih...ich könnt doch auch gleich ne Bsp-Datei uploaden...INKLUSIVE Code UND Bsp-Daten natürlich!
Meine Meinung:
Rudi, toi, toi, toi! Vielleicht hilft es ja :-)
Ciao
Thorsten

Anzeige
AW: Workbooks.Open öffnet Datei nicht
18.12.2014 06:56:33
Marcus
Ich habe den Wink mit dem Zaunpfahl verstanden. Der Code ist mittlerweile nur sehr umfangreich. Ich werde euch die interessanten Stellen hier rein stellen.
Aufruf der Userform durch einen DropDown; alles in einem Tabellenblatt und funktioniert auch einwandfrei (der Code der Userform kommt unten):

Option Explicit
Dim Jahr
Private Sub Worksheet_Change(ByVal Target As Range)
' Spalte T: Berichte ändern
If Target.Column = 22 Then
If Target.Cells = "(1) Bericht anlegen" Then
Call CreateReport(Target.Row)
End If
End If
End Sub
Sub CreateReport(RowNo As Integer)
Dim ProjectName
ProjectName = GetProjectName(RowNo)
Unload UF_CreateReport              'auszuwertende Berichte wählen
With UF_CreateReport
.Tag = Jahr & "." & ProjectName
.Show
End With
Call Berichte_sortieren(RowNo, RowNo)
ActiveSheet.Cells(RowNo, "V").Select
ActiveSheet.Cells(RowNo, "V") = ""
End Sub

Aufruf über das Kontextmenü; die Userform wird aufgerufen aber Workbooks.Open funktioniert nicht:
Das steht im Tabellenblatt

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Jahr = Right(ActiveSheet.Cells(1, 1), 4)
If Not Application.Intersect(Target, Range("W:AF")) Is Nothing Then
Call AddToCellMenu(Target.Row, Target.Column, Jahr)
End If
End Sub
Das steht in Modul 2:

Sub AddToCellMenu(Row, Column, Jahr)
Dim NVHContextMenu As CommandBar
Dim MySubMenu As CommandBarControl
Dim Flag
' Reset the controls first to avoid duplicates.
Call ResetNVHCellMenu
'Set NVHContextMenu to the Cell menu
Set NVHContextMenu = Application.CommandBars("Cell")
'Kontextmenüs passend zum jeweiligen Bericht anzeigen
With NVHContextMenu.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True) _
.OnAction = "'" & ThisWorkbook.Name & "'!" & "BerichtAnlegen(" & Row & "," &  _
Column & "," & Jahr & ")"
.FaceId = 71
.Caption = "Bericht anlegen"
End With
End Sub
Sub ResetNVHCellMenu()
CommandBars("Cell").Reset
End Sub
Sub BerichtAnlegen(R, C, Jahr)
Dim ProjectName
ProjectName = GetProjectName(R)
Unload UF_CreateReport              'auszuwertende Berichte wählen
With UF_CreateReport
.Tag = Jahr & "." & ProjectName
.Show
End With
End Sub
Public Function GetProjectDirectory(RowNo)
Dim MeasurementDir, ProjectName As String
MeasurementDir = "J:\Messdaten\NVH\" & Year(Now) & "\"
ProjectName = GetProjectName(RowNo)
GetProjectDirectory = MeasurementDir & ProjectName      'Projektpfad
End Function
Public Function GetProjectName(RowNo) As String
Dim Name
Name = Range("A" & RowNo).Value & "_" & Range("D" & RowNo).Value & "_" & Range("E" & RowNo). _
Value & "_" & Range("F" & RowNo).Value 'Projektname
GetProjectName = Sonderzeichen(Name)                 'konformen Namen übergeben
End Function
Public Function Sonderzeichen(Buffer)
Buffer = Replace(Buffer, "   ", " ")
Buffer = Replace(Buffer, "  ", " ")
Buffer = Replace(Buffer, " ", "_")
'Buffer = Replace(Buffer, "ä", "ae")
'Buffer = Replace(Buffer, "ö", "oe")
'Buffer = Replace(Buffer, "ü", "ue")
'Buffer = Replace(Buffer, "ß", "ss")
Buffer = Replace(Buffer, "\", "_")
Buffer = Replace(Buffer, "/", "_")
Buffer = Replace(Buffer, "*", ".")
Buffer = Replace(Buffer, "?", ".")
Buffer = Replace(Buffer, """", "_")
Buffer = Replace(Buffer, "", "_")
Buffer = Replace(Buffer, "|", "-")
'Buffer = Replace(Buffer, ",", "_")
Sonderzeichen = Buffer
End Function

So und nun die wesentlichen Stellen der Userform, die wie gesagt in beiden Fällen genutzt wird. Es geht an sich um diese Unterfunktion, die in der Userform steht.

Function GetFPNr(NVHNr, Sprache, Schreib As Boolean)
Application.ScreenUpdating = False
Dim wb As Workbook, geoeffnet As Boolean
Dim Datei, Dateipfad, RowNo, sEnd, I
geoeffnet = False
'Pfad und Dateiname der Belegungsliste aus "Globale VBA-Variablen"
Datei = FP(2)
Dateipfad = FP(1)
'feststellen, ob eine der offenen Mappen wie die Belegungsliste heißt
For Each wb In Application.Workbooks
If wb.Name = Datei Then geoeffnet = True
Next wb
'Wenn Datei von anderem User geöffnet
If Iffileisopen(Dateipfad & Datei) And geoeffnet = False Then
Mldg = "Die Datei " & Datei & " ist bereits von einem anderen User geöffnet." &  _
vbCrLf & "Es wird eine provisorische FP-Nummer vergeben." & vbCrLf & "Bitte ergänzen Sie diese später manuell in der Belegungsliste und ändern Sie den Dateinamen."
Stil = vbOKOnly + vbInformation + vbDefaultButton1
Tit = "Belegungsliste von anderem User geöffnet"
Answer = MsgBox(Mldg, Stil, Tit)
GetFPNr = "xxx"
Else    'Wenn Datei noch nicht offen, dann frei Nummer suchen und belegen
'entsprechend reagieren
If geoeffnet Then
Application.Workbooks(Datei).Activate
Else
Application.Workbooks.Open Filename:=Dateipfad & Datei, UpdateLinks:=0
End If
With Sheets(CStr(Jahr))
For I = 5 To Rows.Count
If .Cells(I, "B") = "" And .Cells(I, "C") = "" And .Cells(I, "D") = "" And . _
Cells(I, "E") = "" And .Cells(I, "F") = "" Then
RowNo = I
Exit For
End If
Next
'Liste füllen
If Schreib Then
If MultiPageCrR.Value = 0 Then
If .Cells(RowNo, 1) = "" Then .Range("A" & RowNo).Value = "FP_" &  _
Format(Right(Jahr, 2), "00") & "_" & RowNo - 4 'Daten eintragen
.Range("B" & RowNo).Value = TBTitel.Value
.Range("C" & RowNo).Value = TBUntertitel.Value
.Range("D" & RowNo).Value = TBKat_Ku.Value
.Range("E" & RowNo).Value = TBProjekt.Value
.Range("F" & RowNo).Value = TBBearbeiter.Value
.Range("G" & RowNo).Value = TBBemerkung.Value
.Range("H" & RowNo).Value = TBDatum.Value
Else
If .Cells(RowNo, 1) = "" Then .Range("A" & RowNo).Value = "FP_" &  _
Format(Right(Jahr, 2), "00") & "_" & RowNo - 4 'Daten eintragen
MsgBox "FP6.7"
.Range("B" & RowNo).Value = TBTitel2.Value
.Range("C" & RowNo).Value = TBUntertitel2.Value
.Range("D" & RowNo).Value = TBKat_Ku2.Value
.Range("E" & RowNo).Value = TBProjekt2.Value
.Range("F" & RowNo).Value = TBBearbeiter2.Value
.Range("G" & RowNo).Value = TBBemerkung2.Value
.Range("H" & RowNo).Value = TBDatum2.Value
End If
Workbooks(Datei).Save
Workbooks(Datei).Close
Else
Workbooks(Datei).Close SaveChanges:=False
End If
End With
'Nummer ausgeben
GetFPNr = RowNo - 4
End If
Application.ScreenUpdating = True
End Function

Anzeige
AW: Workbooks.Open öffnet Datei nicht
18.12.2014 20:01:27
Oberschlumpf
Hmm Marcus
Das is ne Menge Code.
Um all das zu überprüfen, müssten wir jetzt ne Datei mit Userform nachbauen.
Wie wärs, wenn du eine Bsp-Datei erstellst, in der sich alle notwendigen Controls befinden.
Und dann halt nur den Code einsetzen, den du hier zeigst.
Zumindest ich hab keine Zeit, eine Bsp-Datei nachzubauen.
Wenn du sie uns zeigst, würd ich sie mir gern anschauen...vllt kann ich ja helfen.
Ciao
Thorsten

AW: Workbooks.Open öffnet Datei nicht
17.12.2014 15:29:06
yummi
Hallo marcus,
das hört sich für mich wie nicht vollständig referenzierte Variable an. Überprüf doch bitte mal den Inhalt deienr Übergabe an Workbook.open
Falls das identisch ist, wird es ohne Code schwierig dir zu helfen
Gruß
yummi

Anzeige
AW: Workbooks.Open öffnet Datei nicht
18.12.2014 07:13:00
Marcus
Da fällt mir gerade auf, dass das auch bei GetOpenFilename dieses Phänomen auftritt.
Auch dieser Code ist in der Userform hinterlegt.

Private Sub CBCrRVorlage_Click()
Dim Filter
If OBCrRArtFP.Value Or OBCrRArtNVH.Value Then
Filter = "Powerpoint Files (*.pptx; *.ppt),*.pptx; *.ppt"
Else
Filter = "ENT-Berichte (*.docx; *.docm; *.doc),*.docx; *.docm; *.doc"
End If
ChDrive "J"     'Pfad für Getopenfilename einstellen
On Error Resume Next
ChDir ThisWorkbook.Path & "\" & Jahr & "\" & Project & "\3-Auswertung\"
strFullname = Application.GetOpenFilename(Filter, , "Datei auswählen", "Öffnen", False)
strPfad = Left(strFullname, InStrRev(strFullname, "\"))
strFilename = Mid(strFullname, InStrRev(strFullname, "\") + 1)
End Sub

Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige