Gültigkeitsliste per VBA einfügen

Bild

Betrifft: Gültigkeitsliste per VBA einfügen
von: Franz W.
Geschrieben am: 09.11.2003 14:59:36

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
Bild


Betrifft: AW: Gültigkeitsliste per VBA einfügen
von: Ramses
Geschrieben am: 09.11.2003 15:17:06

Hallo Franz

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

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

Dann geht es.

Gruss Rainer


Bild


Betrifft: Mist! Immer wieder dieselben Fehler!!!
von: Franz W.
Geschrieben am: 09.11.2003 15:37:45

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


Bild


Betrifft: Dafür bist du lernfähig... :-)
von: Ramses
Geschrieben am: 09.11.2003 16:28:25

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


Bild


Betrifft: AW: Dafür bist du lernfähig... :-)
von: Franz W.
Geschrieben am: 09.11.2003 17:04:40

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


Bild

Beiträge aus den Excel-Beispielen zum Thema " Diagram"