pain88
Goto Top

VBA Endlosschleife Fehler

Hallo alle zusammen!

Ich beise mir schon die Zähne seit Tag aus wegen einen Schleifen Problem.

Problem Beschreibung:

Ich habe ein Makro das ein Bild aus Excel im Querformat exportieren soll und in einen bestimmten Ordner ablegen soll mit den Namen Inhalt Zelle "A1". Soweit so gut, funktioniert bis dato.

Das Export Bild wird im Laufe des Tages nochmal benötigt, und zwar wird es in eine vorgefertigte Vorlage Importiert, die für ein Querformat ausgelegt ist.
Nun ist es öfters passiert das Kollegen nicht drauf achten ob das Bild in Hoch oder Querformat ist und es somit unbrauchbar für die Vorlage machen.

Nun habe ich mir gedacht die Bildbreite und die Bildhöhe gegenüber zu stellen mit einer abfrage. Falls Breite kleiner als Höhe will ich das Bild das in Excel im Tabellenblatt liegt Löschen und den Loop neu Starten.

Ich bekomme aber bei meinem aktuellen Code immer eine Fehlermeldung. >Next ohne For<* - bei der vorletzenen Zeil hängt es dann.

Das ganze wird von einem Button einer UserForm gestartet.

Anbei mein Code:

'Button "Bild Speichern" in der UserForm "UserFormTestergebnis"  
'Exportiert das Bild in einen vordefinierten Ordner  
Private Sub CommandButton1_Click()

    Dim shp As Shape
    Dim ws As Worksheet

    Dim tempChartObj As ChartObject
    Dim savePath, cellValue, sheetValue, saveName As String

    Set ws = ActiveSheet
        For Each shp In ws.Shapes
            If shp.Type = msoPicture Then
                Set tempChartObj = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)
                cellValue = Range("A1").Value  
                sheetValue = ActiveSheet.Name
                saveName = cellValue & ".jpg"  
                savePath = "MEIN_PFAD" & saveName 'der Pfad passt  
                
                    If tempChartObj.Width < tempChartObj.Height Then
                        GoTo Hell
                        Else: GoTo Weiter
                    End If
                'Kopiert Bild in ein Chart, und exportiert den Chart anschlisend  
                'shp.Rotation = 90  
Weiter:
                shp.Copy
                tempChartObj.Chart.ChartArea.Select
                tempChartObj.Chart.Paste
                tempChartObj.Chart.Export savePath
                tempChartObj.Delete
                shp.Delete
            End If
    Next shp

Unload UserFormTestergebnis
Sheets("Übersicht").Select  

Exit Sub
Hell:
    MsgBox "Die Bildbreite ist kleiner als die Bildhöhe!" _  
    & "Bildbreite: " & tempChartObj.Width _  
    & "Bildhöhe: " & tempChartObj.Height _  
    & "Bitte ein Neues Bild im Querformat machen"  

    MsgBox "Bitte jetzt ein Neues Foto in Querformat aufnehmen"  

    Unload UserFormTestergebnis
    tempChartObj.Delete
    shp.Delete
    Range("C1").Select  
    
    Resume Next shp
    
End Sub 

Also wenn ich ein Querformat Bild benutze klappt alles gut, beim Hochformat kommen die Meldungen von Hell aber der loop gelingt nicht :/

Hat jemand eine Idee wie man das Lösen könnte?
Vielen dank und liebe grüße

Content-Key: 636845

Url: https://administrator.de/contentid/636845

Ausgedruckt am: 29.03.2024 um 15:03 Uhr

Mitglied: AndreasHoster
Lösung AndreasHoster 02.01.2021 um 09:19:03 Uhr
Goto Top
Ich habe mal nur grob drübergeschaut, würde aber sagen, die Fehlermeldung beschreibt so halbwegs das Problem.

Der Parser findet kein <FOR> auf das sich das <Next> in Zeile 53 beziehen kann.
Der eigentliche Fehler ist allerdings, es gibt kein <On Error Goto> für das <Resume Next> in Zeile 53.
Laut Doku MS zu Resume Next:
Setzt die Ausführung fort, nachdem eine Fehler Behandlungs Routine abgeschlossen wurde.

Es ist aber keine Fehlerbehandlungsroutine, Du springst einfach mit Goto dahin.

=> Code in den Hauptcode integrieren oder eine Unterprozedur draus machen, dann sollte es gehen.
Mitglied: pain88
pain88 02.01.2021 aktualisiert um 11:06:50 Uhr
Goto Top
Hallo @AndreasHoster , danke für deinen Tipp.

ich hab es jetzt versucht anzupassen.

'Button "Bild Speichern" in der UserForm "UserFormTestergebnis"  
'Exportiert das Bild in einen vordefinierten Ordner  
Private Sub CommandButton1_Click()

    Dim shp As Shape
    Dim ws As Worksheet

    Dim tempChartObj As ChartObject
    Dim savePath, cellValue, sheetValue, saveName As String
    

    Set ws = ActiveSheet
        For Each shp In ws.Shapes
            If shp.Type = msoPicture Then
                Set tempChartObj = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)
                cellValue = Range("A1").Value  
                sheetValue = ActiveSheet.Name
                saveName = cellValue & ".jpg"  
                savePath = "MEIN PFAD" & saveName  
                
                    If tempChartObj.Width < tempChartObj.Height Then
                        GoTo Hell
                        Else: GoTo Weiter
                    End If

Hell:
            MsgBox "Die Bildbreite ist kleiner als die Bildhöhe!" _  
            & "Bildbreite: " & tempChartObj.Width _  
            & "Bildhöhe: " & tempChartObj.Height _  
            & "Bitte ein Neues Bild im Querformat machen"  

            MsgBox "Bitte jetzt ein Neues Foto in Querformat aufnehmen"  

            Unload UserFormTestergebnis
            'tempChartObj.Delete  
            shp.Delete
            Range("C1").Select  
            End If
    Next shp
    
    
Weiter:
            shp.Copy
            tempChartObj.Chart.ChartArea.Select
            tempChartObj.Chart.Paste
            tempChartObj.Chart.Export savePath
            tempChartObj.Delete
            shp.Delete
    Next shp
    
Exit Sub

Unload UserFormTestergebnis
Sheets("Übersicht").Select  
    
End Sub

Jetzt kommt wieder der Fehler >Next ohne for< bei der 5ten Zeille von unten "Next shp" :/
Es gibt zwar kein <On Error Goto> aber ich habe ja eine abfrage ob Bild-Breite < Bild-Höhe; wenn das stimmt dann --> Hell, sonst -->Weiter oder darf man das nicht so formulieren?

Vielen Dank und liebe Grüße
Mitglied: TsukiSan
Lösung TsukiSan 02.01.2021 um 17:01:19 Uhr
Goto Top
Hallo pain88,

AndreasHoster hat den Grund der berechtigten Fehlermeldung schon erwähnt.
Es ist wohl tatsächlich so,dass der Compilier bei 2 Mal "Next shp" 2 Mal "For" voraussetzt. For Each.. kommt aber nur einmal vor.
Der Compiler versteht ja nicht, dass du springst.

Das geht so nicht.
Du kannst doch aber innerhalb der Schleife springen, sodass beide Optionen "Hell:" und "Weiter:" innerhalb des FOR....NEXT sind.


Grüße

Tsuki
Mitglied: pain88
pain88 04.01.2021 um 13:03:39 Uhr
Goto Top
Hallo @TsukiSan!

Das war tatsächlich der Fehler. Nach deinem Tipp das Ganze innerhalb der Schleife zu machen hat es auch funktioniert.

Vielen lieben Dank!