Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
332to336
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
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Gültigkeitsliste per VBA einfügen

Gültigkeitsliste per VBA einfügen
09.11.2003 14:59:36
Franz W.
Hallo Forum,

ich wünsche allen helfenden Antwortern einen schönen Sonntagnachmittag und erlaube mir, Euch mit einer Frage zu belästigen:

Ich habe einer Zelle eine Gültigkeitsliste zugewiesen und das mit dem Rekorder aufgezeichnet, der Code des Rekorders:


Sub Makro1()
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Zeile A;Zeile B;Zeile C;Zeile D"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub


Markiere ich nun eine Zelle und lasse das Makro laufen, dann finde ich in der Gültigkeitsliste nur eine einzige Zeile, in der alle vorgegebenen Werte mit Semikolon getrennt drin stehen, also genau so: "Zeile A;Zeile B;Zeile C;Zeile D"

Wie muss ich das bitte schreiben, dass er es richtig nimmt? Hab ein bissl rumprobiert, aber nichts erreicht.

Vielen Dank im Voraus und Grüße
Franz

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gültigkeitsliste per VBA einfügen
09.11.2003 15:17:06
Ramses
Hallo Franz

EXCEL versteht kein ";" ;-))
Es muss heissen:

Formula1:="Zeile A,Zeile B,Zeile C,Zeile D"

Dann geht es.

Gruss Rainer
Mist! Immer wieder dieselben Fehler!!!
09.11.2003 15:37:45
Franz W.
Hallo Rainer,

vielen Dank!! Jetzt, wo Du's schreibst, ist es mir klar. Aber selber komm ich mal wieder nicht drauf. Ärgerlich!!

Vielen Dank auf jeden Fall

Darf ich Dir bitte OFF TOPIC ausnahmsweise noch eine weitere Frage stellen? Wenn Du das als ungehörig empfindest, dann lies einfach nicht mehr weiter, ist auch okay.

Falls ja: Ich konnte dies vor einiger Zeit hier nicht klären, konnte mir auch keiner weiterhelfen. Es geht um folgenden Code (zufälligerweise derselbe für den auch meine obige Frage war), Du brauchst ihn nicht ganz durchzufieseln, ich geb unten schon noch an, wo es hakt:


Private Sub Workbook_BeforeClose(Cancel As Boolean)
'    Call UebertragSpeichern
Dim Wb As Workbook, sWb As Variant
Dim Found As Range, sSearch$
Dim loletzte&    '(As Long)
Dim ReNr$, ReDatum As Date, AuftrNr$, AblDatum As Date, _
KdNr$, KdTitel$, KdTiNName$, KdNName$, KdVName$, Betrag@, ZZiel As Date
Dim jZahl%, quartZahl%
With ThisWorkbook.Worksheets("Quartalsrechnung")
jZahl = .[F13]
quartZahl = .[G13]
ReNr = .[H8]
ReDatum = .[H7]
KdNr = .Cells(9, 8)
AblDatum = .[H10]
KdTitel = .[C6]
KdNName = .[D6]
KdTiNName = .[D6] & ", " & .[C6]
KdVName = .[E6]
Betrag = .[H28]
ZZiel = .[J8]
End With
Application.ScreenUpdating = False
''' Prüfen ob "RECHNUNGEN_EH.xls" schon offen
On Error Resume Next
Set sWb = Workbooks("RECHNUNGEN_EH.xls")
If Not IsObject(sWb) Then Workbooks.Open _
Filename:="C:\Dokumente und Einstellungen\bernhard\Eigene Dateien\ENERGIE_HAUSGEMACHT\RechnungenEH\RECHNUNGEN_EH.xls"
On Error GoTo 0
''' Prüfen ob Rechnungsnummer schon vorhanden
sSearch = ReNr
With Workbooks("RECHNUNGEN_EH.xls").Worksheets("Offene")
'    .Activate
.Unprotect
If .Range("A65536") = "" Then loletzte = .Range("A65536").End(xlUp).Row Else loletzte = 65536
Set Found = .Range("A3:A" & loletzte).Find(sSearch, LookIn:=xlValues)
If Not Found Is Nothing Then ' Re-Nr schon vorhanden: Werte überschreiben
With .Range(Found.Address)
.Offset(0, 1) = ReDatum
.Offset(0, 2) = KdNr
.Offset(0, 3) = AblDatum
.Offset(0, 4) = KdTiNName
.Offset(0, 5) = KdVName
.Offset(0, 6) = Betrag
.Offset(0, 7) = ZZiel
'## Mit "Replace" die Punkte verschwinden lassen, damit sie nicht im Dateinnamen drin sind:
KdTitel = Replace(KdTitel, ".", "")
KdNName = Replace(KdNName, ".", "")
KdVName = Replace(KdVName, ".", "")
.Hyperlinks.Add Anchor:=.Offset(0, 10), Address:= _
"C:\Dokumente und Einstellungen\bernhard\Eigene Dateien\ENERGIE_HAUSGEMACHT\RechnungenEH\" _
& jZahl & "\Quartalsrechnungen" & jZahl & "-" & quartZahl & "\" & _
ReNr & " " & KdNr & " " & KdNName & " " & KdVName & " " & KdTitel & ".xls", _
TextToDisplay:="zur Quartalsrechnung"
End With
Else                         ' Re-Nr noch nicht vorhanden: neue Zeile anlegen
loletzte = loletzte + 1
.Cells(loletzte, 1) = ReNr
.Cells(loletzte, 2) = ReDatum
.Cells(loletzte, 3) = KdNr
.Cells(loletzte, 4) = AblDatum
.Cells(loletzte, 5) = KdTiNName
.Cells(loletzte, 6) = KdVName
.Cells(loletzte, 7) = Betrag
.Cells(loletzte, 8) = ZZiel
.Cells(loletzte, 9).Validation.Delete
.Cells(loletzte, 9).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="bar/Kasse,Münchner Bank,Postbank,Verrechnungskonto"
.Cells(loletzte, 9).Validation.IgnoreBlank = True
.Cells(loletzte, 9).Validation.InCellDropdown = True
.Cells(loletzte, 9).Validation.InputTitle = ""
.Cells(loletzte, 9).Validation.ErrorTitle = ""
.Cells(loletzte, 9).Validation.InputMessage = ""
.Cells(loletzte, 9).Validation.ErrorMessage = ""
.Cells(loletzte, 9).Validation.ShowInput = True
.Cells(loletzte, 9).Validation.ShowError = True
'## Mit "Replace" die Punkte verschwinden lassen, damit sie nicht im Dateinnamen drin sind:
KdTitel = Replace(KdTitel, ".", "")
KdNName = Replace(KdNName, ".", "")
KdVName = Replace(KdVName, ".", "")
.Hyperlinks.Add Anchor:=.Cells(loletzte, 11), Address:= _
"C:\Dokumente und Einstellungen\bernhard\Eigene Dateien\ENERGIE_HAUSGEMACHT\RechnungenEH\" _
& jZahl & "\Quartalsrechnungen" & jZahl & "-" & quartZahl & "\" & _
ReNr & " " & KdNr & " " & KdNName & " " & KdVName & " " & KdTitel & ".xls", _
TextToDisplay:="zur Quartalsrechnung"
End If
.Protect
End With
Workbooks("RECHNUNGEN_EH.xls").Save
'Workbooks("RECHNUNGEN_EH.xls").Close SaveChanges:=True
End Sub


Dieser Code klappt einwandfrei, wenn ich HÄNDISCH die Datei schließe, dann tut er genau, was er tun soll!

Allerdings wird der Code aus einer anderen Datei heraus aufgerufen und dann werden nur Teile des Codes ausgeführt, folgende Teile überspringt er, führt sie einfach nicht aus:

- .Unprotect : er hebt den Blattschutz nicht auf

- Set Found = .Range("A3:A" & loletzte).Find(sSearch, LookIn:=xlValues) : diese ZEile übergeht er, er macht immer nur den Teil ab "Else". Im Direktfenster gibt er Found immer mit "0" an.

- am Ende dann übergeht er das Protect und das Speichern der Datei.

Gibt es dafür eine Erklärung oder ist das ein Bug.

Bitte: Antworte bitte nur, falls Du aus dem Ärmel eine Idee hast! Ich hab für mich inzwischen ein Umweg gefunden, mit dem ich das Problem umgehen kann. Hätt mich für die Zukunft nur interessiert, was ich das falsch gemacht habe oder worauf es zu achten gilt. Aber falls der Aufwand zu groß ist, lass es bitte bleiben, es besteht nicht die Notwendigkeit, das jetzt nachzubauen!

Vielen Dank und beste Grüße
Franz
Anzeige
Dafür bist du lernfähig... :-)
09.11.2003 16:28:25
Ramses
Hallo franz,

So richtig kann ich das nicht nachvollziehen.
Der Code sieht eigentlich sauber aus.
Zum Testen würde ich mal das "On Error Resume Next" auskommentieren.
Wenn es zu einem Fehler kommt, aus welchem Grund auch immer, weisst du wenigstens wo der Code klemmt.

Gruss Rainer
AW: Dafür bist du lernfähig... :-)
09.11.2003 17:04:40
Franz W.
Hallo Rainer,

vielen Dank, dass Du Dich reingekniet hast. Die On-Error-Anweisung unterdrückt nur die Fehlermeldung "Index außerhalb des gültigen Bereiches", wenn bei der Zeile
" Set sWb = Workbooks("RECHNUNGEN_EH.xls") " die Datei eben "RECHNUNGEN_EH.xls" noch nicht geöffnet ist. Habs auch schon mal weggelassen, ändert aber nichts. Hab überhaupt - u.a. mit HIlfe von Dan, der meine Frage hier im Forum gelesen hat und ne ganze Menge mehr kann als ich - ein paar Tage lang die verschiedensten Sachen ausprobiert (auch noch per Mail), hat aber alles nicht geändert.

Aber gut, ich hab ja ne Lösung. Drum lassen wir's ruhen :-)))

Vielen Dank auf jeden Fall und beste Grüße
Franz
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige