Office: Endlosschleife

Hallo alle zusammen!

Ich beise 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. Fall 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.

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

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 = "C:UsersTrumicDesktopProjektCovidExcelBilder" & saveName

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

End Sub

:)

 

Hi pani,

da Du neu hier bist...

1. Immer mit angeben: Welche, und an welcher Stelle im Code.
2. Nutze die foreneigenen Codetags zur Darstellung des Codes. Das ist das 2. Bild von rechts, oben im Antwortfenster. Das macht Deinen Code besser lesbar und steigert somit die Bereitschaft, Dir helfen zu wollen. Schön wäre natürlich, wenn der von Haus aus auch ordentlich eingerückt ist.

 

Welche?!?

 

...,vor allem, an welcher Stelle!
Du könntest potentiellen Helfern die Arbeit damit ungemein erleichtern. Oder sollen wir jetzt jede einzelne Zeile Deines Codes durchgehen, um evtl. die Fehlerquelle zu entdecken? Ich sehe für mich keine Veranlassung dazu, solche Nachlässigkeiten zu unterstützen.

 

Hallo,
enthält die Variable savePath einen gültigen Pfad? Ich vermisse einen nach C: und einen weiteren bevor der Dateiname angehängt wird.
Gruss, Wilhelm

 

Diese Zeile passt nicht in den Code:
Code:

Es ist keine Fehlerbehandlung initialisiert.

 

Backslashs müssen maskiert oder verdoppelt werden, damit sie sichtbar werden: \