VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Bilder in einer Schleife ersetzen	01.05.2013 00:35:59	Manuel J.

Ansicht des Beitrags:

Von:
Manuel J.

Datum:
01.05.2013 00:35:59

Views:
1431

Rating:

Antwort:

Thema:
Bilder in einer Schleife ersetzen

Hallo,

ich habe folgendes Problem. Ich habe eine Userform erstellt, die Daten für eine Art Serienetikettendruck auf andere Blätter übertragt und dann drucken soll.

Die reinen Textdaten sind kein Problem. Jedoch machen mir die Bilder Schwierigkeiten.

Auf dem Arbeitsblatt "Druck" im Feld "xy, 4" (XLRowDown) soll auch das Bild relativ verknüpft werden.

Ich verwende dabei eine For-Next-Schleife.

Jedoch funktioniert die Bild-Aktualisierung nur einmal. Danach bleiben die Bilder diesselben wie nach der ersten Änderung.

Zur besseren Einsicht der Code, den ich verwendet habe! Falls es weitere Optimierung-Vorschläge gibt, immer her damit :)

LG Manuel

Dim b As Integer
b = 1
Dim blattzaehler As Integer
'START BETA GROSS
    'Lösche alle Felder auf der Beta-Groß-Seite
            Sheets("Beta-gross-").Cells(21, 1) = ""
            Sheets("Beta-gross-").Cells(22, 1) = ""
            Sheets("Beta-gross-").Cells(11, 2) = ""
            Sheets("Beta-gross-").Cells(4, 7) = ""
            Sheets("Beta-gross-").Cells(5, 7) = ""
            Sheets("Beta-gross-").Cells(6, 7) = ""
            Sheets("Beta-gross-").Cells(7, 7) = ""
            Sheets("Beta-gross-").Cells(8, 7) = ""
            Sheets("Beta-gross-").Cells(11, 8) = ""
            Sheets("Beta-gross-").Cells(13, 8) = ""
            Sheets("Beta-gross-").Cells(15, 8) = ""
            Sheets("Beta-gross-").Cells(16, 8) = ""
            Sheets("Beta-gross-").Cells(17, 8) = ""
            Sheets("Beta-gross-").Cells(18, 8) = ""
            Sheets("Beta-gross-").Cells(15, 10) = ""
            Sheets("Beta-gross-").Cells(16, 10) = ""
            Sheets("Beta-gross-").Cells(17, 10) = ""
            Sheets("Beta-gross-").Cells(18, 10) = ""
            Sheets("Beta-gross-").Cells(45, 1) = ""
            Sheets("Beta-gross-").Cells(46, 1) = ""
            Sheets("Beta-gross-").Cells(26, 11) = ""
            Sheets("Beta-gross-").Cells(28, 7) = ""
            Sheets("Beta-gross-").Cells(29, 7) = ""
            Sheets("Beta-gross-").Cells(30, 7) = ""
            Sheets("Beta-gross-").Cells(31, 7) = ""
            Sheets("Beta-gross-").Cells(32, 7) = ""
            Sheets("Beta-gross-").Cells(35, 2) = ""
            Sheets("Beta-gross-").Cells(37, 8) = ""
            Sheets("Beta-gross-").Cells(39, 8) = ""
            Sheets("Beta-gross-").Cells(40, 8) = ""
            Sheets("Beta-gross-").Cells(41, 8) = ""
            Sheets("Beta-gross-").Cells(42, 8) = ""
            Sheets("Beta-gross-").Cells(39, 10) = ""
            Sheets("Beta-gross-").Cells(40, 10) = ""
            Sheets("Beta-gross-").Cells(41, 10) = ""
            Sheets("Beta-gross-").Cells(42, 10) = ""
blattzaehler = 0
For b = 11 To Sheets("Setup").Range("A65536").End(xlUp).Offset(1, 0).Row
    If VBA.CStr(Sheets("Setup").Cells(b, 1)) = "ja" Then
        If VBA.CStr(Sheets("Setup").Cells(b, 4)) = "BetacamSP gross" Or VBA.CStr(Sheets("Setup").Cells(b, 4)) = "Digibeta gross" Or VBA.CStr(Sheets("Setup").Cells(b, 4)) = "HDCAM gross" Or VBA.CStr(Sheets("Setup").Cells(b, 4)) = "HDCAMSR gross" Then
            If VBA.CStr(Sheets("Beta-gross-").Cells(11, 2)) = "" Then
            'Prüfen, ob bereits Daten im Labelfeld 1/2 vorhanden sind. Falls nicht, werden sie eingefügt.
            'Übertrage Daten (HD/SD)
            Sheets("Beta-gross-").Cells(21, 1) = VBA.CStr(Sheets("Setup").Cells(b, 9))
            'Übertrage Daten (Art des Bandes)
            Sheets("Beta-gross-").Cells(22, 1) = VBA.CStr(Sheets("Setup").Cells(b, 8))
            'Lösche den Druckauftrag, durch Ersetzen des "ja" durch ein "nein" in der aktuellen Zeile
            Sheets("Setup").Cells(b, 1) = "nein"
            'Übertrage Daten (Lfd.-Nr.)
            Sheets("Beta-gross-").Cells(11, 2) = VBA.CStr(Sheets("Setup").Cells(b, 2))
            'Übertrage Daten (Titel)
            Sheets("Beta-gross-").Cells(4, 7) = VBA.CStr(Sheets("Setup").Cells(b, 20))
            'Übertrage Daten (Untertitel)
            Sheets("Beta-gross-").Cells(5, 7) = VBA.CStr(Sheets("Setup").Cells(b, 21))
            'Übertrage Daten (Beschriftung)
            Sheets("Beta-gross-").Cells(6, 7) = VBA.CStr(Sheets("Setup").Cells(b, 37))
            'Übertrage Daten (Clean)
            Sheets("Beta-gross-").Cells(7, 7) = VBA.CStr(Sheets("Setup").Cells(b, 23))
            Sheets("Beta-gross-").Cells(8, 7) = VBA.CStr(Sheets("Setup").Cells(b, 15)) & "/" & VBA.CStr(Sheets("Setup").Cells(b, 16))
            'Übertrage Daten (Video-Settings)
            Sheets("Beta-gross-").Cells(11, 8) = VBA.CStr(Sheets("Setup").Cells(b, 10)) & " | " & VBA.CStr(Sheets("Setup").Cells(b, 11)) & " | " & VBA.CStr(Sheets("Setup").Cells(b, 12))
            'Übertrage Daten (Audio-Settings)
            Sheets("Beta-gross-").Cells(13, 8) = VBA.CStr(Sheets("Setup").Cells(b, 24)) & ", " & VBA.CStr(Sheets("Setup").Cells(b, 25)) & ", " & VBA.CStr(Sheets("Setup").Cells(b, 26))
            'Übertrage Daten (Audio1-8)
            Sheets("Beta-gross-").Cells(15, 8) = VBA.CStr(Sheets("Setup").Cells(b, 27))
            Sheets("Beta-gross-").Cells(16, 8) = VBA.CStr(Sheets("Setup").Cells(b, 28))
            Sheets("Beta-gross-").Cells(17, 8) = VBA.CStr(Sheets("Setup").Cells(b, 29))
            Sheets("Beta-gross-").Cells(18, 8) = VBA.CStr(Sheets("Setup").Cells(b, 30))
            Sheets("Beta-gross-").Cells(15, 10) = VBA.CStr(Sheets("Setup").Cells(b, 31))
            Sheets("Beta-gross-").Cells(16, 10) = VBA.CStr(Sheets("Setup").Cells(b, 32))
            Sheets("Beta-gross-").Cells(17, 10) = VBA.CStr(Sheets("Setup").Cells(b, 33))
            Sheets("Beta-gross-").Cells(18, 10) = VBA.CStr(Sheets("Setup").Cells(b, 34))
            'richtiges Beta-Logo laden
            Sheets("Beta-gross-").BetaProflogogross1.Picture = LoadPicture(ThisWorkbook.Path & "\professional_traeger_logos\" & VBA.CStr(Sheets("Setup").Cells(b, 4)) & ".wmf")
            blattzaehler = blattzaehler + 1

            'Prüfen, ob bereits Daten im Labelfeld 2/2 vorhanden sind. Falls nicht, werden sie eingefügt.
            ElseIf VBA.CStr(Sheets("Beta-gross-").Cells(35, 2)) = "" Then
            'Übertrage Daten (HD/SD)
            Sheets("Beta-gross-").Cells(45, 1) = VBA.CStr(Sheets("Setup").Cells(b, 9))
            'Übertrage Daten (Art des Bandes)
            Sheets("Beta-gross-").Cells(46, 1) = VBA.CStr(Sheets("Setup").Cells(b, 8))
            'Lösche den Druckauftrag, durch Ersetzen des "ja" durch ein "nein" in der aktuellen Zeile
            Sheets("Setup").Cells(b, 1) = "nein"
            'Übertrage Daten (Lfd.-Nr.)
            Sheets("Beta-gross-").Cells(35, 2) = VBA.CStr(Sheets("Setup").Cells(b, 2))
            'Übertrage Daten (Titel)
            Sheets("Beta-gross-").Cells(28, 7) = VBA.CStr(Sheets("Setup").Cells(b, 20))
            'Übertrage Daten (Untertitel)
            Sheets("Beta-gross-").Cells(29, 7) = VBA.CStr(Sheets("Setup").Cells(b, 21))
            'Übertrage Daten (Beschriftung)
            Sheets("Beta-gross-").Cells(30, 7) = VBA.CStr(Sheets("Setup").Cells(b, 37))
            'Übertrage Daten (Clean)
            Sheets("Beta-gross-").Cells(31, 7) = VBA.CStr(Sheets("Setup").Cells(b, 23))
            Sheets("Beta-gross-").Cells(32, 7) = VBA.CStr(Sheets("Setup").Cells(b, 15)) & "/" & VBA.CStr(Sheets("Setup").Cells(b, 16))
            'Übertrage Daten (Video-Settings)
            Sheets("Beta-gross-").Cells(35, 8) = VBA.CStr(Sheets("Setup").Cells(b, 10)) & " | " & VBA.CStr(Sheets("Setup").Cells(b, 11)) & " | " & VBA.CStr(Sheets("Setup").Cells(b, 12))
            'Übertrage Daten (Audio-Settings)
            Sheets("Beta-gross-").Cells(37, 8) = VBA.CStr(Sheets("Setup").Cells(b, 24)) & ", " & VBA.CStr(Sheets("Setup").Cells(b, 25)) & ", " & VBA.CStr(Sheets("Setup").Cells(b, 26))
            'Übertrage Daten (Audio1-8)
            Sheets("Beta-gross-").Cells(39, 8) = VBA.CStr(Sheets("Setup").Cells(b, 27))
            Sheets("Beta-gross-").Cells(40, 8) = VBA.CStr(Sheets("Setup").Cells(b, 28))
            Sheets("Beta-gross-").Cells(41, 8) = VBA.CStr(Sheets("Setup").Cells(b, 29))
            Sheets("Beta-gross-").Cells(42, 8) = VBA.CStr(Sheets("Setup").Cells(b, 30))
            Sheets("Beta-gross-").Cells(39, 10) = VBA.CStr(Sheets("Setup").Cells(b, 31))
            Sheets("Beta-gross-").Cells(40, 10) = VBA.CStr(Sheets("Setup").Cells(b, 32))
            Sheets("Beta-gross-").Cells(41, 10) = VBA.CStr(Sheets("Setup").Cells(b, 33))
            Sheets("Beta-gross-").Cells(42, 10) = VBA.CStr(Sheets("Setup").Cells(b, 34))
            'richtiges Beta-Logo laden
            Sheets("Beta-gross-").BetaProflogogross2.Picture = LoadPicture(ThisWorkbook.Path & "\professional_traeger_logos\" & VBA.CStr(Sheets("Setup").Cells(b, 4)) & ".wmf")
            blattzaehler = blattzaehler + 1

Worksheets("Beta-gross-").Visible = True
Worksheets("Beta-gross-").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

    'Lösche alle Felder auf der Beta-Groß-Seite
            Sheets("Beta-gross-").Cells(21, 1) = ""
            Sheets("Beta-gross-").Cells(22, 1) = ""
            Sheets("Beta-gross-").Cells(11, 2) = ""
            Sheets("Beta-gross-").Cells(4, 7) = ""
            Sheets("Beta-gross-").Cells(5, 7) = ""
            Sheets("Beta-gross-").Cells(6, 7) = ""
            Sheets("Beta-gross-").Cells(7, 7) = ""
            Sheets("Beta-gross-").Cells(8, 7) = ""
            Sheets("Beta-gross-").Cells(11, 8) = ""
            Sheets("Beta-gross-").Cells(13, 8) = ""
            Sheets("Beta-gross-").Cells(15, 8) = ""
            Sheets("Beta-gross-").Cells(16, 8) = ""
            Sheets("Beta-gross-").Cells(17, 8) = ""
            Sheets("Beta-gross-").Cells(18, 8) = ""
            Sheets("Beta-gross-").Cells(15, 10) = ""
            Sheets("Beta-gross-").Cells(16, 10) = ""
            Sheets("Beta-gross-").Cells(17, 10) = ""
            Sheets("Beta-gross-").Cells(18, 10) = ""
            Sheets("Beta-gross-").Cells(45, 1) = ""
            Sheets("Beta-gross-").Cells(46, 1) = ""
            Sheets("Beta-gross-").Cells(35, 2) = ""
            Sheets("Beta-gross-").Cells(28, 7) = ""
            Sheets("Beta-gross-").Cells(29, 7) = ""
            Sheets("Beta-gross-").Cells(30, 7) = ""
            Sheets("Beta-gross-").Cells(31, 7) = ""
            Sheets("Beta-gross-").Cells(32, 7) = ""
            Sheets("Beta-gross-").Cells(35, 8) = ""
            Sheets("Beta-gross-").Cells(37, 8) = ""
            Sheets("Beta-gross-").Cells(39, 8) = ""
            Sheets("Beta-gross-").Cells(40, 8) = ""
            Sheets("Beta-gross-").Cells(41, 8) = ""
            Sheets("Beta-gross-").Cells(42, 8) = ""
            Sheets("Beta-gross-").Cells(39, 10) = ""
            Sheets("Beta-gross-").Cells(40, 10) = ""
            Sheets("Beta-gross-").Cells(41, 10) = ""
            Sheets("Beta-gross-").Cells(42, 10) = ""

            'Sollten alle Blätter voll Sein, wird zuerst ausgedruckt und danach die Zellen wieder entleert.
            Application.Wait Now + TimeSerial(0, 0, 2)
            Else

            End If
        End If
    End If
Next b

'Restliche Betacam-Gross-Blätter
If blattzaehler Mod 2 > 0 Then
Worksheets("Beta-gross-").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Else
End If
b = 0
blattzaehler = 0
    'Lösche alle Felder auf der Beta-Groß-Seite
            Sheets("Beta-gross-").Cells(21, 1) = ""
            Sheets("Beta-gross-").Cells(22, 1) = ""
            Sheets("Beta-gross-").Cells(2, 11) = ""
            Sheets("Beta-gross-").Cells(4, 7) = ""
            Sheets("Beta-gross-").Cells(5, 7) = ""
            Sheets("Beta-gross-").Cells(6, 7) = ""
            Sheets("Beta-gross-").Cells(7, 7) = ""
            Sheets("Beta-gross-").Cells(8, 7) = ""
            Sheets("Beta-gross-").Cells(11, 8) = ""
            Sheets("Beta-gross-").Cells(13, 8) = ""
            Sheets("Beta-gross-").Cells(15, 8) = ""
            Sheets("Beta-gross-").Cells(16, 8) = ""
            Sheets("Beta-gross-").Cells(17, 8) = ""
            Sheets("Beta-gross-").Cells(18, 8) = ""
            Sheets("Beta-gross-").Cells(15, 10) = ""
            Sheets("Beta-gross-").Cells(16, 10) = ""
            Sheets("Beta-gross-").Cells(17, 10) = ""
            Sheets("Beta-gross-").Cells(18, 10) = ""
            Sheets("Beta-gross-").Cells(45, 1) = ""
            Sheets("Beta-gross-").Cells(46, 1) = ""
            Sheets("Beta-gross-").Cells(26, 11) = ""
            Sheets("Beta-gross-").Cells(28, 7) = ""
            Sheets("Beta-gross-").Cells(29, 7) = ""
            Sheets("Beta-gross-").Cells(30, 7) = ""
            Sheets("Beta-gross-").Cells(31, 7) = ""
            Sheets("Beta-gross-").Cells(32, 7) = ""
            Sheets("Beta-gross-").Cells(35, 2) = ""
            Sheets("Beta-gross-").Cells(37, 8) = ""
            Sheets("Beta-gross-").Cells(39, 8) = ""
            Sheets("Beta-gross-").Cells(40, 8) = ""
            Sheets("Beta-gross-").Cells(41, 8) = ""
            Sheets("Beta-gross-").Cells(42, 8) = ""
            Sheets("Beta-gross-").Cells(39, 10) = ""
            Sheets("Beta-gross-").Cells(40, 10) = ""
            Sheets("Beta-gross-").Cells(41, 10) = ""
            Sheets("Beta-gross-").Cells(42, 10) = ""

            'ENDE BETA GROSS

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Bilder in einer Schleife ersetzen	01.05.2013 00:35:59	Manuel J.