AW: Hide <-> Unload
04.10.2003 10:11:35
Franz W.
Hallo Rainer,
ich glaub, ich schreib als Level wieder "mäßig" ... ich verzweifel grad ein bissl:
Das mit der Variablen hab ich jetzt kapiert, dieser Unterschied zwischen den Modulen war mir noch nicht klar. Jetzt klappt aber mein bisheriger Code nicht mehr *seufz*: die obere Hälfte brauchst Du nicht anschauen.
Sub NeuenKundenEingeben()
KdBildPfad = Sheets("Help").[D26]
Smly = Worksheets("Help").[C18]
'Dateinamen von Bildern einlesen:
With Application.FileSearch
.LookIn = KdBildPfad
.Filename = "*.jpg"
.Execute
dlgKdAendern.cmbBilderNamen.Clear
For intCounter = 1 To .FoundFiles.Count
komplett = .FoundFiles(intCounter)
'In der folgenden Schleife wird der einzlesende und auszugebende Dateiname _
von hinten her Buchstabe für Buchstabe zusammengesetzt.
'Dies würde eigentlich bei i = 0 losgehen.
'Die "4", damit die Extension nicht mit angezeigt wird, _
weil die letzten 4 Zeichen abgezogen werden:
For i = 4 To Len(komplett)
'Sobald von hinten her ein "\" erreicht wird, is genug. _
Damit wird nur der Dateiname ausgegeben ohne Pfad:
If Mid(komplett, Len(komplett) - i, 1) = "\" Then Exit For
pctName = Mid(komplett, Len(komplett) - i, 1) & pctName
Next i
dlgKdAendern.cmbBilderNamen.AddItem pctName
pctName = ""
Next
End With
'Neue Kundennummer einlesen, restliche Felder leer machen:
With dlgKdAendern
.Caption = "Kunden eingeben"
.bezAenderKunde.Caption = "Kundendaten eingeben:"
.txtKdNr = Format(Worksheets("Help").Cells(2, 2) + 1, "000")
' .txtTitel = ""
' .txtNName = ""
' .txtVName = ""
' .txtco = ""
' .txtStrasse = ""
' .txtPLZ = ""
' .txtOrt = ""
' .txtObjekt = ""
' .txtKtoNr = ""
' .txtBLZ = ""
' .txtBank = ""
' .txtNotiz = ""
.Image1.Picture = LoadPicture(Smly)
Beep
'Dialog aufrufen:
dlgKdAendern.txtTitel.SetFocus
dlgKdAendern.Show
End With
Application.ScreenUpdating = False
If result = False Then
Exit Sub
Else
Worksheets("Help").Cells(2, 2) = Format(dlgKdAendern.txtKdNr, "0")
With Sheets("Daten")
.Unprotect
.Range("DatenTabelle").Select
iHilf = Selection.Row + Selection.Rows.Count - 1
.Rows(iHilf - 1).Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveSheet.Paste
Application.CutCopyMode = False
.Cells(iHilf, 2) = Format(dlgKdAendern.txtKdNr, "0")
.Cells(iHilf, 3) = dlgKdAendern.txtTitel
.Cells(iHilf, 4) = dlgKdAendern.txtNName
.Cells(iHilf, 5) = dlgKdAendern.txtVName
.Cells(iHilf, 6) = dlgKdAendern.txtco
.Cells(iHilf, 7) = dlgKdAendern.txtStrasse
.Cells(iHilf, 8) = dlgKdAendern.txtPLZ
.Cells(iHilf, 9) = dlgKdAendern.txtOrt
.Cells(iHilf, 10) = dlgKdAendern.txtObjekt
.Cells(iHilf, 11) = dlgKdAendern.txtKtoNr
.Cells(iHilf, 12) = dlgKdAendern.txtBLZ
.Cells(iHilf, 13) = dlgKdAendern.txtBank
If dlgKdAendern.cmbBilderNamen = "" Then
Cells(iHilf, 59) = ""
Else
Cells(iHilf, 59) = dlgKdAendern.cmbBilderNamen
End If
dlgKdAendern.cmbBilderNamen.Clear
.Cells(iHilf, 60) = dlgKdAendern.txtNotiz
strAusgabe = ""
For intSpalte = 61 To 71
' Fehlerbehandlung, weil es einen Fehler gibt, wenn kein Kommentar eingetragen ist _
und in Cells(r, 72) "#WERT!" steht:
On Error Resume Next
If Cells(iHilf, intSpalte) <> "" Then
strAusgabe = strAusgabe & Cells(iHilf, intSpalte) & Chr(10)
End If
On Error GoTo 0
Next
'Den letzten Zeilenumbruch, nach dem kein Text mehr folgt, löschen:
If Right(strAusgabe, 1) = vbLf Then
strAusgabe = Left(strAusgabe, Len(strAusgabe) - 1)
End If
If dlgKdAendern.txtNotiz <> "" Then
Set cmt = Cells(iHilf, 4).AddComment _
(Text:=(Trim(dlgKdAendern.txtTitel & " " & dlgKdAendern.txtVName & " " & dlgKdAendern.txtNName & ":") _
& Chr(10) & strAusgabe))
With cmt.Shape
.TextFrame.AutoSize = True
With .TextFrame.Characters(1, InStr(1, cmt.Text, Chr(10)) - 1)
.Font.Bold = True
.Font.Underline = True
End With
End With
End If
Range("DatenTabelle").WrapText = False 'Kein Zeilenumbruch im Datenbereich
.Protect
End With
End If
Application.ScreenUpdating = True
Call Sortieren_nach_Namen
ActiveWorkbook.Save
End Sub
Was er noch macht, ist die neue Zeile einfügen. Aber Werte trägt er keine mehr ein. Ich kriege nur eine neue leere Zeile.
(Denselben Dialog mit ähnlichem Code - am Anfang werden vorhandene Daten eingelesen - nehme ich auch her, um Daten eines bereits existierenden Kunden zu ändern. Auch das klappt jetzt nicht mehr. Betätige ich nach Aufruf der UF den Ok-Button, löscht er sämtliche Inhalte der Zeile und lässt nur die leere ZEile stehen!)
Verzweifelte Grüße
Franz