Zwischen den Druck aktualisieren

Question

Hallo liebe Excelianer,

eigentlich bin ich ja total stolz auf mich, da ich eine Random Funktion ohne Wiederholungen zustande bekommen habe. Die Random Funktion habe ich gebraucht, um verschiedene Fragen für meinen Wissenstest zusammenzustellen.

Nun möchte ich diesen Test 100 mal drucken. Dabei soll aber jeder Test neu aktualisiert werden, so dass niemand den gleichen Test bekommen wird. Also meine banale Vorstellung ist es auf irgendein Icon für Drucken zu klicken, die Anzahl der Kopien einzugeben und dann wird gedruckt, aktualisiert, gedruckt, aktualisiert usw.

Ist das irgendwie möglich? den Befehl Calculate kenne ich in VBA aber ich komme nicht mit der Verbindung zum Drucken und mit der Aktualisierung dazwischen klar.

Könntet Ihr mir bitte weiterhelfen?

Vielen Dank.

Peter

Answer 1

Hallo Peter,

versuch mal das folgende Makro:

Sub mehrfach_drucken()

Dim sEingabe As String
Dim lEingabe As Long

'Eingabe der Anzahl des Ausdrucks
sEingabe = InputBox("Wie oft soll das Blatt gedruckt werden?")

'Eingabe wird in Ganzzahl umgewandelt
lEingabe = Val(sEingabe)

'Prüfen, ob Eingabe gültige Zahl war
If lEingabe < 1 Then
'Falls nicht wird Makro mit Fehlermeldung beendet
MsgBox "Ungültige Eingabe - Abbruch!", 16, "Fehler"
Exit Sub
End If

For i = 1 To lEingabe

Calculate 'neu berechnen
ActiveSheet.PrintOut Copies:=1 'auf Standard-Drucker ausdrucken

Next i

End Sub

Gruß

M.O.

Answer 2

hi all ^^

ein wenig offtopic
eine mögliche variante eines frage antwort spieles
Ausgabe der Zufallsdaten
Tabelle1 Spalte A=Frage
nach Clich auf die MsgBox
Tabelle1 Spalte B=Antwort

es erfolgt ein kommpletter durchlauf der Daten ohne doppelte
und wird dann neu gestartet

Beliebige Datenmenge
Tabelle2 spalte a=fragen
Tabelle2 spalte b=antworten

gruss nighty

Global Index As Long

Global zuzahl() As Long

Global Dday() As Variant

Sub FrageAntwort()
If Index = 0 Then
MsgBox ("Der Fragen Katalog wird neu gestartet !")
Randomize Timer
Dim Endeindex As Long, Allezahlen As Long, Lzeile As Long
Dim Gezogen As Long, Zahl As Long
Worksheets(2).Activate
Lzeile = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Dday = Range("A1:A" & Lzeile)
ReDim Preserve zuzahl(Lzeile)
For Allezahlen = 1 To Lzeile
zuzahl(Allezahlen) = Allezahlen
Next Allezahlen
Index = Lzeile
End If
Worksheets(1).Activate
Endeindex = Index
Gezogen = Int(Rnd * Endeindex) + 1
Zahl = zuzahl(Gezogen)
zuzahl(Gezogen) = zuzahl(Endeindex)
Endeindex = Endeindex - 1
ReDim Preserve zuzahl(Endeindex)
Cells(1, 1) = ""
Cells(1, 1) = Dday(Zahl, 1)
Index = Endeindex
MsgBox ("Deine Antwort ?")
Cells(1, 2) = Worksheets(2).Cells(Zahl, 2)
End Sub

Answer 3

hi all ^^

noch bisl korrigiert

gruss nighty

Global Index As Long

Global zuzahl() As Long

Sub FrageAntwort()
If Index = 0 Then
MsgBox ("Der Fragen Katalog wird neu gestartet !")
Randomize Timer
Dim Endeindex As Long, Allezahlen As Long, Lzeile As Long
Dim Gezogen As Long, Zahl As Long
Lzeile = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve zuzahl(Lzeile)
For Allezahlen = 1 To Lzeile
zuzahl(Allezahlen) = Allezahlen
Next Allezahlen
Index = Lzeile
End If
Endeindex = Index
Gezogen = Int(Rnd * Endeindex) + 1
Zahl = zuzahl(Gezogen)
zuzahl(Gezogen) = zuzahl(Endeindex)
Endeindex = Endeindex - 1
ReDim Preserve zuzahl(Endeindex)
Range("A1:B1") = ""
Cells(1, 1) = Worksheets(2).Cells(Zahl, 1)
Index = Endeindex
MsgBox ("Deine Antwort ?")
Cells(1, 2) = Worksheets(2).Cells(Zahl, 2)
End Sub