Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
168to172
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
168to172
168to172
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makroproblem

Makroproblem
18.10.2002 08:58:17
Andreas
Hallo Leute,

wer von euch kann mir sagen, warum das folgende makro nicht läuft.Dabei geht es um folgendes. Nach der Eingabe einer laufenden Nummer soll ein Beleg gedruckt werden. Dazu soll in einer Datenbank ein Datensatz ausgelesen werden, der die spalten 1 bis 32 umfasst. Die Datenbank beginnt ab Zeile 11. Jetzt soll über ein Eingabefenster die laufende Nummer eingegeben werden von 1 bis 290. Anhand dieser Nummer (Sie steht in der Datenbank in Spalte A)soll die entsprechende Zeile in Zeile 1 kopiert werden. Ein Druckblatt habe ich schon vorbereitet (Die in Zeile 1 kopierten Daten werden automatisch dort angezeigt.)die zu druckenden Bereiche heissen Englisch und Kopie1. Datenbak und Druckbereiche sind im gleichen Blatt. Trotzdem kopiert mein Makro nicht die entsprechende Zeile in Zeile 1. Ich habe auch schon eine zweite Variante gestestet, aber auch die läuft nicht.

Sub test()
'
' test Makro
Dim Mldg
Mldg = "Bitte lfd. Nr. eingeben"
Titel = "InputBox"
Voreinstellung = "1"
Suchwert = InputBox(Mldg, Titel, Voreinstellung)
zeile = 11

Do Until zeile < 301

Cells.Find(What:=Suchwert, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:="", MatchCase:= _
False).Activate

Range(Cells(zeile, 1), Cells(zeile, 23)).Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ActiveSheet.PageSetup.PrintArea = "Buchungsanzeige"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ActiveSheet.PageSetup.PrintArea = "Kopie"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

zeile = zeile + 1
Loop
Range("A1").Select

Range("A1").Select
End Sub

bzw. der andere Versuch:
Dim Mldg
Mldg = "Bitte lfd. Nr. eingeben"
Titel = "InputBox"
Voreinstellung = "1"
Suchwert = InputBox(Mldg, Titel, Voreinstellung)
zeile = 11

If Cells.Find(What:=Suchwert, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:="", MatchCase:= _
False).Activate = Suchwert.Value Then

Range(Cells(zeile, 1), Cells(zeile, 23)).Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ActiveSheet.PageSetup.PrintArea = "Buchungsanzeige"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ActiveSheet.PageSetup.PrintArea = "Kopie"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.8)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.35)
.HeaderMargin = Application.InchesToPoints(0.511811023)
.FooterMargin = Application.InchesToPoints(0.511811023)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = 1
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Else: Do Until Cells.Find(What:=Suchwert, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:="", MatchCase _
:=False).Activate = Suchwert.Value
zeile = zeile + 1
Loop
End If
Range("A1").Select

VIELEN DANK im voraus für die schnelle Hilfe.

Andreas




6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Makroproblem
18.10.2002 09:12:37
jinx
Moin, ANdreas,

die Bedingung ist bereits erfüllt, bevor es zur Ausführung kommt.
Der Fehler liegt bei Do Until zeile < 301 - dies muss heißen Do Until zeile > 301 ...


cu
jinx

Re: Makroproblem
18.10.2002 09:17:45
Andreas
Habe das ausprobiert. jetzt hängt das makro beim cells.find aufruf. Warum nur???
Re: Makroproblem
18.10.2002 09:30:56
jinx
Moin, Andreas,

gem. OH: SearchDirection Variant optional. Zulässig sind die XlSearchDirection-Konstanten xlNext oder xlPrevious. Die Standardkonstante ist xlNext.

Wenn Du also den Parameter ersatzlos weglässt...

cu
jinx

Re: Makroproblem
18.10.2002 10:54:15
Andreas
Hallo Jinx,

auch das reicht nicht. er meldet immer noch einen Laufzeitfehler in der cells.find funktion.

gruss,

andreas

Anzeige
Re: Makroproblem
19.10.2002 10:43:19
jinx
Moin, Andreas,

eine Fehlermeldung erscheint bei mir, wenn ich einen Suchbegriff eingebe, der in der Liste nicht gefunden wird - hier muß noch eine Routine zur Fehlerbehandlung eingebaut werden.

cu
jinx

Re: Makroproblem
21.10.2002 08:19:01
Andreas
hi,

danke für die tatkräftige hilfe. jetzt läuft alles prima.

grüsse,

andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige