Eigenschaft ListFillRange Eigenschaft fehlt

[Crazy Tom]

Hallo

die meisten Eigenschaften der Steuerelemente kann man auch im Code setzen


MfG Tom

[MdeJong]

Hallo Tom,


deine Codeerweiterung funktioniert.

Ich bin eigentlich fertig mit meiner Adressdatenbank.....bleibe aber an der automatischen Nummernvergabe hängen.

Soweit geht das mit der neue Nummer schon......aber nicht, wenn ich einen neuen Kontakt speichern will.
da beleibt die nummernvergabe leer.......nur wenn ich die Datei neu aufrufe.

Meine userform hat einen Multipageaufbau....mit..."Hauptmenü"....."Neue Adresse eingeben" und "Page3" zum anzeigen Tabellenblatt.

Ich habe folgenden Code mit Hilfe aus deinen letzten Codes aus meiner Filmdaten zum abspeichern eines neuen Kontaktes angelegt:

Code:

Private Sub cmdDatenSpeichern_Click()

'Schließt das Formular und übernimmt die Daten ins Tabellenblatt
Dim intersteleerzeil As Long

With ActiveSheet

intErsteLeereZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
 
   .Cells(intErsteLeereZeile, 1).Value = Me.txtNummer.Value
   .Cells(intErsteLeereZeile, 2).Value = Me.cboAnrede.Value
   .Cells(intErsteLeereZeile, 3).Value = Me.txtVorname.Value
   .Cells(intErsteLeereZeile, 4).Value = Me.txtName.Value
   .Cells(intErsteLeereZeile, 5).Value = Me.txtStraße.Value
   .Cells(intErsteLeereZeile, 6).Value = Me.txtHausnummer.Value
   .Cells(intErsteLeereZeile, 7).Value = Me.txtPostleitzahl.Value
   .Cells(intErsteLeereZeile, 8).Value = Me.txtWohnort.Value
   .Cells(intErsteLeereZeile, 9).Value = Me.txtFestnetz.Value
   .Cells(intErsteLeereZeile, 10).Value = Me.txtFax.Value
   .Cells(intErsteLeereZeile, 11).Value = Me.txthandy.Value
   .Cells(intErsteLeereZeile, 12).Value = Me.txtGeburtsdatum.Value
   .Cells(intErsteLeereZeile, 13).Value = Me.txtMailadress.Value
   .Cells(intErsteLeereZeile, 13).Value = Me.txtWebsite.Value
   .Cells(intErsteLeereZeile, 15).Value = Me.txtInfoPerson.Value
       
   For Each objControl In Controls  'leert die Textboxen
       Select Case TypeName(objControl)
           Case "TextBox"
           objControl.Text = ""
           End Select
       Next
     End With
 
End Sub

das abspeichern klappt und die TextBoxen werden geleert für eine Neueingabe, doch es wird keinen neue Nummer vergeben.

Erst wenn ich die Datei speichere und neu aufrufe?

Dieser Code steckt hinter der Userform:

Code:

Private Sub UserForm_Initialize()
  Me.MultiPage1.Value = 0
  cboAnrede.RowSource = "Anrede"
  Dim lngLetzte As Long
  With Worksheets("Datenblatt")
      lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
  End With
  With ListBox1
      .RowSource = "Datenblatt!A2:M" & lngLetzte
      .ColumnCount = 13        'Angabe Spaltenanzahl
      .ColumnHeads = True
      .ColumnWidths = "35;40;75;75;75;30;35;75;75;75;75;65;80"    
  End With
  With Worksheets("Datenblatt")
       lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
       txtNummer.Value = .Cells(lngZeile, 1).Value + 1
       txtNummer.Enabled = False    
       TextBox3.Enabled = False    
  End With

End Sub

Wie bringe ich dem Code in der 2. Page  ("Neue Adresse eingeben" )bei, das er einen neue Nummer danach generieren soll?

Gruß

MdeJong

[Crazy Tom]

Hallo

das möchte ich nicht unbedingt nachbauen
wäre also besser wenn du eine Beispieldatei hochladen würdest

MfG Tom

[MdeJong]

  AdressBuch-TestMappe.xlsm (Größe: 38,85 KB / Downloads: 7) Ok,

hier meine Mappe  

[Crazy Tom]

Hallo

ersetze folgenden Code im Initialize

Code:

  With Worksheets("Datenblatt")
       lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
       txtNummer.Value = lngZeile '.Cells(lngZeile, 1).Value + 1
       txtNummer.Enabled = False    'hier keine Eingabemöglichkeit in der Textbox
       TextBox3.Enabled = False     'hier keine Eingabemöglichkeit in der Textbox
  End With

und das hier ergänzend im cmdDatenSpeichern

Code:

    For Each objControl In Controls  'leert die Textboxen
        Select Case TypeName(objControl)
            Case "TextBox"
            objControl.Text = ""
            End Select
        Next
    cboAnrede.ListIndex = -1
    txtNummer.Value = .Cells(intersteleerezeile, 1).Value + 1
    End With

MfG Tom

[MdeJong]

Hallo Tom,


so funktioniert es. :)

Beim erstellen der Adressverwaltung, habe ich bei der Verwendung einiger deiner Codes aus dem Projekt "Filmdatenbank", die Funktion der einzelnen Befehle erst richtig verstanden.

Sicher hakt es immer an Kleinigkeiten...zumindest sind es sicher für dich Kleinigkeiten  ;)

Ich bin somit mit dieser Mappe fertig. :)

Wenn ich in der Adressdatenbank zu den Kontakten auch Bilder anzeigen lassen möchte, ist das so wie in dem letzten Objekt möglich?

Im alten Projekt, wurde die TextBox19 "Name des Films" mit der passenden Datei, gleichen Namens angezeigt.

Nun gibt es in der Adressdatenbank....zwei Bedingungen um das passende Bild dazu anzeigen zu lassen.
Vorname und Nachnahme (2 verschiedene TextBoxen).
Vorname und Nachname könnte gleich sein, halt nur anderer Ort oder Straße usw?

Gruß
de Jong

[Crazy Tom]

Hallo

entweder setzt du den Namen für das Bild aus den TextBoxen zusammen
z.B. Textbox1 & " " & Textbox2
oder benenne das Bild doch einfach nach der laufenden Nummer


MfG Tom

[MdeJong]

Hi Tom,


ich hab es hinbekommen, zu den Kontakten das passende Foto anzeigen zu lassen.  :)

Gruß

MdeJong