Code ...
09.10.2003 17:50:20
alex
Hier ist eins der kleineren ...
Sub AllIn_TEST_freieEinträge()
Dim sheet As String
AllIn_DBTEST.Show
wohin = AllIn_DBTEST.result
If wohin = 0 Then
MsgBox ("Keine Datenbank ausgewählt")
Unload AllIn_DBTEST
End
End If
If wohin = 1 Then
Sheets("Produktions-Rezepturen-1").Select
sheet = ActiveSheet.name
End If
If wohin = 3 Then
Sheets("Entwicklungs-Rezepturen-1").Select
sheet = ActiveSheet.name
End If
If wohin > 3 Then
Sheets("Entwicklungs-Rezepturen-1").Select
sheet = ActiveSheet.name
wohin = 0
End If
Application.ScreenUpdating = False
weiter1:
Range("h:h,DD:DD").Select
Dim artnr As String
Dim fs4, f4
With Selection
Set found = .Find(what:="Freie", lookat:=xlPart)
If found Is Nothing Then
Set fs4 = CreateObject("Scripting.FileSystemObject")
Set f4 = fs4.OpenTextFile("c:\Fehler_REZListe_freieEintraege.txt", 8, True)
f4.write "Keinen Freien Eintrag gefunden." + vbNewLine
f4.Close
End If
foundfirst = found.Address
If Not found Is Nothing Then
Do
'found.Activate
If (found.Offset(0, 4) <> 0) Then
Set fs4 = CreateObject("Scripting.FileSystemObject")
Set f4 = fs4.OpenTextFile("c:\Fehler_REZListe_freieEintraege.txt", 8, True)
f4.write "Freien Eintrag mit Preis in Zeile " + Str(found.Row) + "gefunden." + vbNewLine
f4.Close
found.Offset(0, 4) = 0
r = found.Row
c = found.Column
artnr = found.Offset(0, -7)
Sheets("Art.Nr.Hilfsblatt").Select
Range("a1").Select
'MsgBox (artnr)
Do Until (ActiveCell = artnr)
Selection.Offset(1, 0).Select
Loop
Selection.Offset(0, 16) = r
Selection.Offset(0, 17) = c
Sheets(sheet).Select
End If
Set found = .FindNext(found)
Loop While found.Address <> foundfirst
Else
End
End If
Call makeNewSheetName(sheet)
For k = 1 To Sheets.Count
If Sheets(k).name = sheet Then
Sheets(sheet).Select
nextline = 0
GoTo weiter1
End If
Next k
If wohin = 0 Then
Sheets("Produktions-Rezepturen-1").Select
sheet = ActiveSheet.name
nextline = 0
wohin = 1
GoTo weiter1
End If
End With
End Sub
Beim Debuggen (F8) meldet sich nun der VBA-Editor mit :
Fehler beim Kompilieren.
Projekt doer Bibliothek nicht gefunden.
in der Zeile : wohin = AllIn_DBTEST.result (also die 2. oder 3. )