Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
280to284
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
280to284
280to284
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code überprüfen

Code überprüfen
20.07.2003 10:26:57
Franz W.
Guten Morgen Forum,
mit Eurer tatkräftigen Unterstützung habe ich den folgenden Code zusammengestellt, der auch funktionert. Vielleicht mag mal einer drüber schauen, ob noch Fehler drin sind, die ich noch nicht bermerkt habe, oder ob es sonst noch was dazu zu sagen gibt.
2 Schwächen (mindestens 2, die, die mir klar sind... ;-)) ! ) sind noch drin:
- Wie es heißt sollte u.a. "GoTo" vermieden werden: ist es möglich das
" GoTo KdPruef "
zu umgehen?
- " Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Activate " - dritte Zeile nach " KdPruef: " bring ich auch nicht weg. Ohne geht's nur wenn die Datei "OffeneRechnungen.xls" erst geöffnet werden muss. Dadurch wird sie wohl aktiviert. Wenn sie schon offen ist und ich die explizite Aktivierung rauslasse findet er schon vorhandene Werte nicht und schreibt einen neuen Eintrag.
Das Makro wird durch Button ausgelöst.

Sub DatenInOffRechnUebertr()
Dim Wb As Workbook, sWb As String
Dim Found As Range, sSearch As String
Dim LoLetzte&    '(As Long)
Dim KdNr%, KdTitel$, KdNName$, KdVName$, Kdco$
KdNr = ActiveCell
KdTitel = ActiveCell.Offset(0, 1).Value
KdNName = ActiveCell.Offset(0, 2).Value
KdVName = ActiveCell.Offset(0, 3).Value
Kdco = ActiveCell.Offset(0, 4).Value
Application.ScreenUpdating = False
''' Prüfen ob "OffeneRechnungen.xls" schon offen
sWb = "OffeneRechnungen.xls"
For Each Wb In Application.Workbooks
If Wb.Name = sWb Then
GoTo KdPruef
End If
Next
Workbooks.Open Filename:="E:\Microsoft\Excel\Bernhard\OffeneRechnungen.xls"
KdPruef:
''' Prüfen ob Kundennummer schon vorhanden
sSearch = Format(KdNr, "000")
Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Activate
Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Unprotect
With Workbooks("OffeneRechnungen.xls").Worksheets("Offene")
LoLetzte = 65536
If Range("A65536") = "" Then LoLetzte = Range("A65536").End(xlUp).Row
Set Found = Range("A1:A" & LoLetzte).Find(sSearch, LookIn:=xlValues)
If Not Found Is Nothing Then        ' KdNr schon vorhanden: Werte überschreiben
With Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Range(Found.Address)
.Offset(0, 1) = KdTitel
.Offset(0, 2) = KdNName
.Offset(0, 3) = KdVName
.Offset(0, 4) = Kdco
End With
Else                                ' KdNr noch nicht vorhanden: neue Zeile anlegen
With Workbooks("OffeneRechnungen.xls").Worksheets("Offene")
LoLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
.Cells(LoLetzte, 1) = KdNr
.Cells(LoLetzte, 2) = KdTitel
.Cells(LoLetzte, 3) = KdNName
.Cells(LoLetzte, 4) = KdVName
.Cells(LoLetzte, 5) = Kdco
End With
End If
End With
Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Protect
Workbooks("OffeneRechnungen.xls").Save
'Workbooks("OffeneRechnungen.xls").Close SaveChanges:=True
End Sub

Schon mal vielen Dank für Eure Mühe.
Grüße
Franz

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code überprüfen
20.07.2003 10:48:16
Jens
Hallo
Ich habe mal den Code etwas umgebaut. Du arbeites zwar mit "with" aber vergisst immer wieder den "." vor "rang..." zum Beispiel.

Sub DatenInOffRechnUebertr()
Dim Wb As Workbook, sWb As Variant
Dim Found As Range, sSearch As String
Dim LoLetzte&    '(As Long)
Dim KdNr%, KdTitel$, KdNName$, KdVName$, Kdco$
KdNr = ActiveCell
KdTitel = ActiveCell.Offset(0, 1).Value
KdNName = ActiveCell.Offset(0, 2).Value
KdVName = ActiveCell.Offset(0, 3).Value
Kdco = ActiveCell.Offset(0, 4).Value
Application.ScreenUpdating = False
''' Prüfen ob "OffeneRechnungen.xls" schon offen
On Error Resume Next
Set sWb = Workbooks("OffeneRechnungen.xls")
If Not IsObject(sWb) Then Workbooks.Open Filename:="E:\Microsoft\Excel\Bernhard\OffeneRechnungen.xls"
On Error GoTo 0
''' Prüfen ob Kundennummer schon vorhanden
sSearch = Format(KdNr, "000")
With Workbooks("OffeneRechnungen.xls").Worksheets("Offene")
.Activate 'aber eigenlich nicht nötig
.Unprotect
If .Range("A65536") = "" Then LoLetzte = .Range("A65536").End(xlUp).Row Else LoLetzte = 65536
Set Found = .Range("A1:A" & LoLetzte).Find(sSearch, LookIn:=xlValues)
If Not Found Is Nothing Then        ' KdNr schon vorhanden: Werte überschreiben
With .Range(Found.Address)
.Offset(0, 1) = KdTitel
.Offset(0, 2) = KdNName
.Offset(0, 3) = KdVName
.Offset(0, 4) = Kdco
End With
Else                                ' KdNr noch nicht vorhanden: neue Zeile anlegen
LoLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
.Cells(LoLetzte, 1) = KdNr
.Cells(LoLetzte, 2) = KdTitel
.Cells(LoLetzte, 3) = KdNName
.Cells(LoLetzte, 4) = KdVName
.Cells(LoLetzte, 5) = Kdco
End If
.Protect
End With
Workbooks("OffeneRechnungen.xls").Save
'Workbooks("OffeneRechnungen.xls").Close SaveChanges:=True
End Sub

Code nicht auf lauffähigkeit getestet, hätte da erste eine Tabelle in der Form deiner Tabelle erstellen müssen.
Gruß Jens

Anzeige
Toll!!
20.07.2003 11:24:58
Franz W.
Hallo Jens,
war ja fast schon ein bisschen stolz auf mein Konstrukt, aber mit Deiner Fehlerbereinigung! Vielen Dank für Deine Änderungen. Hab noch nicht alles durchgetestet, aber bis jetzt klappt er, bisher noch keine Fehler. (Und das in nur wenigen Minuten *staunimmerwieder!*). Er klappt auch ohne das ".Activate"! Genau wie Du's schreibst!
Ist interessant für einen Anfänger (drum hat auch meine Antwort etwas gedauert :-))). Vor allem auch toll die Streichungen von unnötigem Ballast oder doppelt Gemoppeltem.
Das meiste hab ich kapiert (glaub ich jedenfalls :-)), aber ein paar Fragen hätte ich noch dazu:
1. Warum hast Du Dim sWB von String auf Variant geändert? Ist das für IsObject erforderlich?
2. Sehe ich richtig, dass "On Error GoTo 0" die On Error-Anweisung wieder zurücksetzt? Das "On Error Resume Next" also nicht für das ganze Makro, sondern nur für die darauffolgenden zwei Zeilen gilt?
3. Das mit dem "." vor Range seh ich schon ein. Nur geklappt hat's ja trotzdem?!?!?!???????
Ganz vielen Dank und Grüße
Franz

Anzeige
AW: Toll!!
20.07.2003 11:33:36
Jens
Hallo
>1. Warum hast Du Dim sWB von String auf Variant geändert? Ist das für IsObject
>erforderlich?
Ich benötige eine Variable ohne direkte Definition was sie ist.
as Object würde bei isObject(sWB) immer dazuführen das die Datei gefunden wird
as String geht nicht da ich versuche ein Object zu erstellen
as Vaiant alles geht rein, String, Zahlen, Objecte usw.
>2. Sehe ich richtig, dass "On Error GoTo 0" die On Error-Anweisung wieder zurücksetzt?
>Das "On Error Resume Next" also nicht für das ganze Makro, sondern nur für die
>darauffolgenden zwei Zeilen gilt?
Richtig das ist auch der einzige Punkt wo goto erlaubt ist (Error abfangen)
gruß Jens

Anzeige
Super!
20.07.2003 11:38:47
Franz W.
Hallo Jens,
hast mir sehr weitergeholfen, vielen Dank dafür.
Grüße
Franz

AW: Code überprüfen
20.07.2003 10:35:22
Hajo_Zi
Hallo Franz
ich würde mal ohne Testung schreiben, schreibe für
Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Activate
Workbooks("OffeneRechnungen.xls").Worksheets("Offene").Unprotect
With Workbooks("OffeneRechnungen.xls").Worksheets("Offene")
With Workbooks("OffeneRechnungen.xls").Worksheets("Offene")
.Unprotect
Gruß Hajo
Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Anzeige
Leider nein. Noch dasselbe ... o.T.
20.07.2003 10:45:36
Franz W.
Glaube hab's nur falsch eingefügt, sorry ot
20.07.2003 11:26:40
Franz W.

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige