Ich habe mir jetzt beide Codes angesehen.
Code zum Speichern auf Page "Neuer Kontakt"
und den Code "Cover einfügen, auf Page "Hauptmenü"
Im Code: Private Sub Foto_einfuegen()
Code:
Private Sub Foto_einfuegen()
Dim xFn As Long
Dim strDatei As String
Dim xText As String
Dim strPath As String
strPath = "D:\AdressBuchDaten\" 'Pfad anpassen <-- auf schreibweise und Backslash achten
ListBox3.Clear
xFn = FreeFile
strDatei = txtVorname.Text & " " & txtName.Text
With AdressBook
.Image1.Picture = Nothing
On Error Resume Next
.Image1.Picture = LoadPicture(strPath & TextBox2.Text & " " & TextBox14.Text & ".jpg")
If Dir(strPath & strDatei & ".txt") <> "" Then
Open strPath & strDatei & ".txt" For Input As xFn
Do While Not EOF(1)
Line Input #xFn, xText
ListBox3.AddItem xText
Loop
Close xFn
End If
On Error GoTo 0
End With
End Sub
muss diese Zeile unter: xFn = FreeFile
strDatei = Textzbox2.Text & " " & TextBox14.Text
genau die gleichen TextBoxen ansprechen wie Zeile Load Pcture. ( Die Bilder läd er ja rein).
der Code zum speichern neuer Kontakte, speichert ja richtig....glaub ich auf jeden Fall...kann ich erst heute Abend ausprobieren.
Hier noch einmal der Speicherncode von Page "Neue Adresse eingeben"
Code:
Private Sub cmdDatenSpeichern_Click()
'Schließt das Formular und übernimmt die Daten ins Tabellenblatt
Dim intersteleerzeil As Long
Call WriteFile("D:\AdressBuchDaten\" & txtVorname.Text & " " & txtName.Text & ".txt", txtInfoPerson)
'hier wir Vor und Nachname als Dateiname benutzt
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, 14).Value = Me.txtWebsite.Value
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
MsgBox "Datensatz wurde erstellt und Textdatei gespeichert"
End Sub
Kann ich mir eigentlich nur so vorstellen?
Gruß
MdeJong
