AW: Kommentar (aus Zelle) in Variable schreiben
23.04.2005 16:50:08
Axel
Hallo Nepumuk,
vielen Dank für Deine Mühe, es geht leider nocht nicht. Ich habe 2x den gleichen Befehl, nur das eine mal lese ich den Wert des Feldes aus, das andere mal will ich den Kommentartext aus dieser Zelle auslesen, und da steigt mein Programm aus.
hier mal das Listing des Programms.
Danke im voraus für Deine Antwort
Sub Hauptprog()
'_______________________________________________________________
' Name : Hauptprogramm
' Datum : 24.4.05
' Autor : Axel Chudzik
' Dieses Programm liest aus einer vorgegeben Matrix (Checkliste
' Kundenanforderungen) die bestehenden aktuellen Forderungen aus,
' diese Daten werden dann in Tabelle2 gesammelt und sollen danach
' in eine Word Datei, um eine fertige Korrespondenz/Anfrage dem
' Kunden zu senden
Dim KdNr As Long
Dim CheckDat As Date
Dim CheckTyp As String
Dim Zähl As Integer
Dim i As Integer
Dim Wert1 As String
Dim Wert2 As String
Dim Wert3 As String
Const Forderung1 = "Allgemeine Vereinbarungen"
Const Forderung2 = "QM-Forderungen"
Const Forderung3 = "Reklamationen"
Const Forderung4 = "Lieferbedingungen"
Const Forderung5 = "Umweltrichtlinien"
Dim BereichSpalte As Range
Set BereichSpalte = Range("c1:c500")
Dim BereichZeile As Range
Set BereichZeile = Range("e3:cc3")
Sheets("Tabelle2").Select
Cells.Clear
Columns("A:A").ColumnWidth = 3
Columns("B:B").ColumnWidth = 3
Columns("C:C").ColumnWidth = 10
Columns("D:D").ColumnWidth = 50
Sheets("Tabelle1").Select
On Error GoTo fehler
Beginn:
i = 0
KdNr = InputBox("Geben Sie die Kd.Nr. ein!", _
"KundenNummer eingeben")
If IsNumeric(KdNr) Then
Else
MsgBox "Bitte Ziffern eingeben"
GoTo Beginn
End If
' Suchen der eingegebenen Kunden Nummer
Range("a1").Select
Cells.Find(What:=KdNr, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
k = ActiveCell.Row ' Erfassen der gefundenen Zeile
j = 1 ' Schleifenzähler für Tabelle 2
ActiveCell.Offset(0, 2).Activate
For Zähl = 1 To ActiveSheet.UsedRange.Columns.Count ' Schleife mit Abtastung WerteBreite
i = i + 1
If IsEmpty(ActiveCell.Value) Then ' Abprüfung Datum in Kundenforderung
' Falls leer gehe zum nächsten Feld
Else ' Falls nicht leer ...
Wert1 = ActiveCell.Value ' Datumswert
Wert2 = ActiveCell.Offset(rowOffset:=(k - 3) * (-1), columnOffset:=0).Value ' Text Kundenanforderungen
Wert3 = ActiveCell.Offset(rowOffset:=(k - 3) * (-1), columnOffset:=0).Comment.Text ' Text aus Kommentarfeld
Worksheets("Tabelle2").Activate ' Aktiviere Tabelle 2
Range("a1").Select ' Setze Koordinate
ActiveCell.Offset(j, 2).Value = Wert1 ' Schreibe Datum
ActiveCell.Offset(j, 3).Value = Wert2 ' Schreibe Kundenanforderung
ActiveCell.Offset(j, 4).Value = Wert3 ' Schreibe spezielle Forderung (Kommentar)
j = j + 1
Worksheets("Tabelle1").Activate
End If
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate ' Spalte um 1 nach rechts
Next Zähl ' Schleifenende
' Aufrufen und schreiben in Word Datei
Exit Sub
fehler:
MsgBox "Sie haben keine gültige Kd.Nr. eingegeben!"
GoTo Beginn
End Sub