|
Ich versuche, die Datenüberwachung einer Zelle als Liste mit VBA zu definieren. Wenn ich Schleifen verwende, um den String zu füllen, funktioniert zwar die Definition, aber beim erneuten Öffnen der Datei gibt mir Excel ein Fehler aus und ich muss die Datei reparieren. Any suggestions?
Hier mein code:
Private Sub Workbook_Open()
Dim intZaehlerSupplement As Integer, intZaehlerZeile As Integer
Dim strSupplement As String
Dim xlwbBase As Excel.Workbook
'Globale Variablen schreiben
If Right(Sheets("lookup").Range("$B$1"), 1) = "\" Then
strPathPreislisten = Sheets("lookup").Range("$B$1")
Else
strPathPreislisten = Sheets("lookup").Range("$B$1") & "\"
End If
If Right(Sheets("lookup").Range("$B$2"), 1) = "\" Then
strPathBase = Sheets("lookup").Range("$B$2")
Else
strPathBase = Sheets("lookup").Range("$B$2").Text & "\"
End If
blnEurokurs = Sheets("lookup").Range("$B$3")
blnFaktoren = Sheets("lookup").Range("$B$4")
On Error GoTo Fehler1
Set xlwbBase = GetObject(strPathBase & "base.xlsx")
strSupplement = ""
strAdd = "-"
intZaehlerSupplement = 3
Do Until strAdd = ""
strSupplement = strSupplement & "," & strAdd
strAdd = xlwbBase.Sheets("supplement").Cells(intZaehlerSupplement, 1).Value
intZaehlerSupplement = intZaehlerSupplement + 1
Loop
With Sheets(2).Range("D37").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=strSupplement
End With
Exit Sub
Fehler1:
Select Case Err
Case 432
MsgBox "Beim Öffnen der Datei base.xlsx ist ein Fehler aufgetreten. Bitte Pfad für hinterlegte Basisdaten unter Einstellungen prüfen."
Case Else
MsgBox "Beim Initialisieren der Arbeitsmappen ist ein Fehler aufgetreten. Bitte prüfen sie die Einstellungen."
End Select
Exit Sub
End Sub
|