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

Schleife: Wenn Bedinung erfüllt - füge neues Blatt

Schleife: Wenn Bedinung erfüllt - füge neues Blatt
18.05.2006 15:31:13
Sophie
Hallo!
Zerbreche schon seit Tagen den Kopf. Möglicherweise versuche ich was unmögliches zu erzwingen...
Also, ich möchte die Werte in den Zellen E7, E9, E11 ... bis E35 auslesen. Die Werte können 1, 2 oder 3 sein (sind auswählbar in einem Kombinationsfeld).
Falls der Wert der Zelle Falls der Wert der Zelle 3 ist, gehe bitte zu der nächsten Zelle, solange bis E35 erreicht ist.
Danach markiere, liebe VBA, alle neu eingefügten Blätter und gebe sie alle in Druckansicht aus.
Ich habe was probiert, aber es funktioniert bei mir nicht...
Vielleicht hat jemand eine Idee.
Wäre sehr-sehr dankbar!!!
LG
Sophie

Sub Makro1()
Dim i As Range
Dim Ende As Range
For i = E7 To Ende
If i < 3 Then
Set NewSheet = Worksheets.Add
NewSheet.Activate
Range("A1").Select
ActiveSheet.Pictures.Insert("C:\Dokumente und Einstellungen\E7.jpg").Select
ActiveWindow.SelectedSheets.PrintPreview
Else
i = i + 2
End If
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife: Wenn Bedinung erfüllt - füge neues B
18.05.2006 20:27:37
Klaus
Hallo Sophie,
dieses sollte in etwa das sein, was du brauchst. Du mußt am Anfang des Codes den Tabellennamen anpassen (und eventuell den Bilderpfad):

Sub Makro1()
Dim intCounter As Integer, Blätter() As Integer
Dim AnzahlBlätterVorher As Integer, AnzahlBlätterNachher As Integer
Dim TabelleDaten As Worksheet, Bilderpfad As String
'Ordner mit den jpg-Bildern
Bilderpfad = "C:\Dokumente und Einstellungen\"
'TABELLENNAMEN ANPASSEN !!! (Hier ist der Beispielname "Tabelle1")
'Dieses ist die Tabelle mit Daten 1, 2 oder 3 in E7, E9, E11 usw.
Set TabelleDaten = Sheets("Tabelle1")
AnzahlBlätterVorher = Sheets.Count
For intCounter = 7 To 35 Step 2
With TabelleDaten.Cells(intCounter, 5) '5 = Spalte E
If .Value < 3 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Pictures.Insert (Bilderpfad & _
.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ".jpg")
End If
End With
Next intCounter
AnzahlBlätterNachher = Sheets.Count
ReDim Blätter(AnzahlBlätterVorher + 1 To AnzahlBlätterNachher)
For intCounter = AnzahlBlätterVorher + 1 To AnzahlBlätterNachher
Blätter(intCounter) = intCounter
Next intCounter
Sheets(Blätter).Select
ActiveWindow.SelectedSheets.PrintPreview
'Warnungen und Meldungen abschalten
Application.DisplayAlerts = False
If MsgBox("Alle neuen Blätter wieder löschen ?", vbQuestion + vbYesNo, "Neue Blätter löschen ?") = vbYes Then
ActiveWindow.SelectedSheets.Delete
End If
'Warnungen und Meldungen wieder einschalten
Application.DisplayAlerts = True
End Sub

Gruß Klaus
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige