schleife erweitern
27.02.2017 15:38:49
thomas
zur Zeit drucke ich mit dem unten stehenden Macro alle Dateien welche in einer Liste
" "b2:b" & Worksheets(1) " stehen. Liste lade ich mir auch mit in die Listbox.
Nun versuche ich gerade mein Macro so zu erweitern das nur die Datein gedruckt werden welche über multiselect markiert wurden. Dazu habe ich mir gedacht ich markiere diese Daten mit einem "ja" hinter dem Datensatz hole mir ein "Ja" in die zelle F3 und bringe dann der schleife bei " Drucke dies nur wenn in Zelle "F3" ein "ja" steht.
Und genau an dieser stelle komme ich leider nicht weiter.
kann sich dies mal bitte anschauen? Da ich dies bestimmt dumm erklärt habe sende ich ein beispiel ( mein stand ) mit.
https://www.herber.de/bbs/user/111803.xlsm
habt schon mal besten dank für euer Interesse.
mfg thomas
Public Sub datei_drucken_3()
Dim Pfad As String
Dim zelle As Range
'### drucker aussuchen !!!!!!!!!!!!! verschoben '######################################### _
Dim strPrinterName As String
Dim varRueckgabe As Variant
strPrinterName = Application.ActivePrinter
varRueckgabe = Application.Dialogs(xlDialogPrinterSetup).Show
If Worksheets(1).Range("b2") = "" Then
MsgBox " Habe leider nichts zu drucken Du must erst die Daten kopieren"
Exit Sub
End If 'If varRueckgabe = False Then End If 'Exit Sub
'drucker aussuchen bis hier '################################################################### _
'UserForm1.
UserForm1.Hide
For Each zelle In Worksheets(1).Range("b2:b" & Worksheets(1).Cells(Rows.Count, "B").End(xlUp). _
Row)
If zelle "" Then
'Dein Code
'MsgBox Workbooks.Open
'Pfad = Zelle
Pfad = ThisWorkbook.Worksheets(1).Range("e3").Value
With Workbooks.Open(Filename:=Pfad) 'Worksheets(1)
'With Workbooks.Open(Filename:=Pfad)
' nur wenn in f3 ein ja steht
.PrintPreview
'.ActiveSheet.Range("A3:DN6000").Copy Destination:=ThisWorkbook.Worksheets("Tabelle2").Range(" _
A3")
.Close savechanges:=False 'oder true, wenn Änderungen gespeichert werden sollen
End With
End If
Next
UserForm1.Show
'Aktiver Drucker wieder erstellen !!!!!!!!!!!!! verschoben
Application.ActivePrinter = strPrinterName
End Sub
Public Sub mit_ja_markieren()
' schreibt ein a neben Datensatz wenn in Listbox markiert wurde
Worksheets(1).Range("c1:c2000").Clear
Dim x&
With UserForm1.ListBox1
For x = .ListCount - 1 To 0 Step -1 'die Schleife unbedingt rücwärts laufen lassen!
If .Selected(x) = True Then
'.RemoveItem (x)
Worksheets(1).Cells(x + 1, 2).Offset(1, 1) = "Ja" 'PrintPreview 'ClearContents
End If
Next
End With
End Sub