Zeitvergleich bei Ausführung

Hallo Profis,
ich habe ein Problem, wo ich einfach nicht gelöst bekomme.
Zum Problem:
Ich habe eine kleine Datenbank in Spalte B4:B1000, wo Materialnummern stehen. Diese werden sporadisch mittels einer Userform gesucht und gegebenenfalls wo ausgedruckt. Funktioniert einwandfrei.
Nun möchte ich folgenden Zusatz:
Jedes mal, wenn ein Ausdruck einer Mat.Nr. erfolgt, soll in Spalte D und in der passenden Zeile das Datum mit Uhrzeit in die Zelle reingeschrieben werden. Erfolgt ein weiterer Ausdruckbefehl der identischen Mat.-Nr., darf nur ausgedruckt werden, wenn mindestens 10min zwischen den Uhrzeiten liegen. Wenn nicht, soll eine MsgBox erscheinen. Darüber hinaus soll in Spalte E und der passenden Zeile ein Zähler für die Anzahl der "Ausdruckbefehle" geschrieben werden.
Ich hoffe ich habe soweit alles gut und verständlich beschrieben.
Vielen Dank für eure Hilfe! :)
Grüße
Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Vorschlag...

22.08.2018 09:15:53

Werner

AW: Vorschlag...

22.08.2018 09:41:07

Micha

Ich gebe dir auch das Sub für die Sortierung mit :)

Sub Sortierung()
Dim Teilname As String
Dim Kategorienanzahl As Long
Dim Text As String
Dim j As Long
Dim bolFound As Boolean
Application.ScreenUpdating = False
'Zu suchende Variable festlegen
Text = Worksheets("Kartenerstellung").Range("B2")
'Range für die Suche nach der Materialnummer festlegen
With Worksheets("Datenbank")
Kategorienanzahl = .Cells(.Rows.Count, 2).End(xlUp).Row
bolFound = False
For j = 4 To Kategorienanzahl
Teilname = .Cells(j, 2).Value
'Suche nach der Materialnummer und hole das passende Bild
If Text Like "*" & Teilname & "*" Then
Sheets("Kartenerstellung").Range("C1").Value = .Cells(j, 3).Value
'Wenn Bild vorhanden, Unterprogramm für die Formatierung starten
bolFound = True
Call prcCopyShapeObject(Ziel:=Sheets("Kartenerstellung").Range("C1"), _
Quelle:=.Cells(j, 3), TopLeft:=False)
Exit For
End If
Next j
End With
'Wenn Materialnummer nicht vorhanden, Fehler in MSG-Box melden
If bolFound = False Then
MsgBox "Materialnummer nicht vorhanden"
End If
Application.ScreenUpdating = True
End Sub

Der Druck ist nur ein Bild in einer bestimmten Größe auf einem bestimmten Drucker. Es nimmt keinen Bezug auf die vorherige Sortierung.

Private Sub CommandButton2_Click()
'Druckbefehl für das aktuelle Range
ActiveSheet.PageSetup.Orientation = xlPortrait      'Querformateinstellung
ActiveSheet.PageSetup.PrintArea = "A1:C5"       'Range
Application.ActivePrinter = "\\XY:"  'Druckername
ActiveSheet.Printout    'Drucken
Unload Me
Bestätigung.Show
End Sub

Ich hoffe das hilft dir weiter :)
Danke für deine Hilfe.
Grüße

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeitvergleich bei Ausführung

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread