Das Bild ist zu gross und wird abgeschnitten

Forumthread: Das Bild ist zu gross und wird abgeschnitten

06.07.2016 14:54:56

Gregor

Hallo zusammen
Seit einiger Zeit erhalte ich beim Schliessen einer Datei die Fehlermeldung "Das Bild ist zu gross und wird abgeschnitten" immer dann, wenn ich vorgängig folgendes Makro ausgelöst habe:
Sub Handlungsbedarf_alle_Infrastrukturanlagen()
'Fehlermeldung
On Error GoTo out
GetMoreSpeed True
'*****************************allgemeiner Teil************************************
Blattname = "Infra Gesamt"
With Worksheets("Master Datei")
Spalte_P_RV_IK = .Application.Match("Infra-Koo P", .Rows(1), 0)
Spalte_Nutzlänge = .Application.Match("Perronnutzlänge", .Rows(1), 0)
Spalte_P_Länge = .Application.Match("Handlungsbedarf Perronnutzlänge", .Rows(1), 0)
Spalte_P_Höhe = .Application.Match("Handlungsbedarf Perronhöhe", .Rows(1), 0)
Spalte_treppenfrei = .Application.Match("Handlungsbedarf treppenfreier Zugang", .Rows(1), 0)
'---Jahr unlogisch
If Jahr1 = "" Or Jahr2 = "" Or Jahr2 MsgBox prompt:="Auswahl unlogisch, bitte gewählte Jahre überprüfen", _
Title:=" Hinweis an " & Application.UserName
GetMoreSpeed False
End
End If
'--- eruiert letzte Zeile/Spalte
intlastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
intLastRow = .Cells(Rows.Count, Spalte_Nutzlänge).End(xlUp).Row
End With
'*** Loop 1 Beginn
Application.DisplayAlerts = False
'--- löscht Blatt wenn vorhanden
For Each Blatt In ActiveWorkbook.Sheets
If Blatt.Name = Blattname Then
Worksheets(Blatt.Name).Delete
End If
Next Blatt
Application.DisplayAlerts = True
'*** Loop 1 Ende
'--- blendet Blatt Vorlage ein
Worksheets("Vorlage").Visible = xlSheetVisible
'--- kopiert Blatt Vorlage nach Blatt "Pilot"
Worksheets("Vorlage").Copy After:=Sheets(Sheets.Count)
Worksheets("Vorlage (2)").Name = Blattname
'--- blendet Blatt Vorlage definitv aus
Worksheets("Vorlage").Visible = xlVeryHidden
'***************************Ende allgemeiner Teil********************************
Call alle
With Worksheets(Blattname)
'--- prüft ob auf Blatt 'Blattname' Einträge vorhanden
intLastRow = .Cells(Rows.Count, Spalte_Nutzlänge).End(xlUp).Row
If intLastRow Application.DisplayAlerts = False
'--- löscht Blatt 'Blattname'
.Delete
Application.DisplayAlerts = True
MsgBox prompt:="Es ist kein Handlungsbedarf für Infrastrukturbauten" _
& vbLf & "gemäss Ihren Kriterien aufgeführt", _
Title:=" Info an " & Application.UserName
Worksheets("Pilot").Select
' Unload usrMaster_Warten
GetMoreSpeed False
Exit Sub
End If
'---löscht Spalten "i"
Spalte_Info_Muster = .Application.Match("Detail-Info Muster", .Rows(1), 0)
.Columns(Spalte_Info_Bahnhof).Delete
Spalte_Info_Roma = .Application.Match("Detail-Info Roma", .Rows(1), 0)
.Columns(Spalte_Info_Roma).Delete
Spalte_Info_Perron = .Application.Match("Detail-Info Perron", .Rows(1), 0)
.Columns(Spalte_Info_Perron).Delete
Spalte_Info_KI = .Application.Match("Detail-Info KI", .Rows(1), 0)
.Columns(Spalte_Info_KI).Delete
Spalte_Einsatz_FVRoma = .Application.Match("Planung FV-Roma-Einsatz", .Rows(1), 0)
.Columns(Spalte_Einsatz_FVRoma).Delete
Spalte_Einsatz_RVRoma = .Application.Match("Planung RV-Roma-Einsatz", .Rows(1), 0)
.Columns(Spalte_Einsatz_RVRoma).Delete
Spalte_Info_Handlungsbedarf = .Application.Match("Handlungsbedarf", .Rows(1), 0)
.Columns(Spalte_Info_Handlungsbedarf).Delete
'--- löscht alle Shapes
.DrawingObjects.Delete
'---eruiert Spalten-Buchstabe von DIDOK
Spalte_DIDOK = .Application.Match("DIDOK", .Rows(1), 0)
Ziel = Application.Substitute(Cells(1, Spalte_DIDOK - 1).Address(0, 0), 1, "")
'--- löscht Spalten B bis J
.Columns("B:" & Ziel).Delete Shift:=xlToLeft
.Cells.EntireColumn.AutoFit
End With
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Application.StatusBar = False
GetMoreSpeed False
Exit Sub
out:
MsgBox prompt:="Fehler Nummer " & Err.Number & " ist aufgetreten in" _
& vbNewLine & "Sub Handlungsbedarf_alle_Infrastrukturanlagen()" _
& vbNewLine & vbNewLine & "Die Ausführung wird beendet" _
& vbNewLine & "Wenden Sie sich an den Ersteller", _
Title:=" Fehlermeldung"
Worksheets("Pilot").Select
GetMoreSpeed False
End Sub Sub alle()
With Worksheets("Master Datei")
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For Zeile = 6 To intLastRow
Handlungsbedarf = False
Muster = .Cells(Zeile, 1).Value
If Muster = "" Then
Muster = .Cells(Zeile, 1).End(xlDown).Value
Zeile = .Cells(Zeile, 1).End(xlDown).Row
End If
ZeileEnd = IIf(IsEmpty(.Cells(Zeile + 1, 1)), IIf(IsEmpty(.Cells(.Cells(Zeile, 1).End(xlDown).Row - 1, Spalte_Nutzlänge)), .Cells(.Cells(Zeile, 1).End(xlDown).Row, Spalte_Nutzlänge).End(xlUp).Row, .Cells(Zeile, 1).End(xlDown).Row - 1), Zeile)
'--- eruiert zu durchsuchenden Bereich Jahre
Set rng4 = Union( _
.Range(.Cells(Zeile, Spalte_P_Länge), .Cells(ZeileEnd, Spalte_P_Länge)), _
.Range(.Cells(Zeile, Spalte_P_Höhe), .Cells(ZeileEnd, Spalte_P_Höhe)), _
.Range(.Cells(Zeile, Spalte_treppenfrei), .Cells(ZeileEnd, Spalte_treppenfrei)))
'---Handlungsbedarf alle Jahre
If Jahr1 = "alle Jahre" And Jahr2 = "alle Jahre" Then
If WorksheetFunction.CountA(rng4) > 0 Then Handlungsbedarf = True
Else
'---Handlungsbedarf ausgewählte Jahre
For Each d In rng4.Cells
If d.Value >= Jahr1 * 1 And d.Value Handlungsbedarf = True
Exit For
End If
Next
End If
If Handlungsbedarf = True Then
'--- eruiert zu durchsuchenden Bereich Priorität
Set rng5 = Union( _
.Range(.Cells(Zeile, Spalte_P_Länge + 3), .Cells(ZeileEnd, Spalte_P_Länge + 3)), _
.Range(.Cells(Zeile, Spalte_P_Höhe + 3), .Cells(ZeileEnd, Spalte_P_Höhe + 3)), _
.Range(.Cells(Zeile, Spalte_treppenfrei + 2), .Cells(ZeileEnd, Spalte_treppenfrei + 2)))
Prio = False
Select Case Priorität
'Priorität 3
Case 3
For Each z In rng5.Cells
If z.Value = 3 Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität 2
Case 2
For Each z In rng5.Cells
If z.Value = 2 Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität 1
Case 1
For Each z In rng5.Cells
If z.Value = 1 Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität 1 / 2 / 3
Case Is = "1 / 2 / 3"
For Each z In rng5.Cells
If z.Value = 3 Or z.Value = 2 Or z.Value = 1 Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität S
Case Is = "S"
For Each z In rng5.Cells
If z.Value = "S" Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität MUP
Case Is = "MUP"
For Each z In rng5.Cells
If z.Value = "MUP" Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität P
Case Is = "P"
For Each z In rng5.Cells
If z.Value = "P" Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
'Priorität MUP / P
Case Is = "MUP / P"
For Each z In rng5.Cells
If z.Value = "MUP" Or z.Value = "P" Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
Case Else
For Each z In rng5.Cells
If z.Value = 3 Or z.Value = 2 Or z.Value = 1 Or z.Value = "S" Or z.Value = "MUP" Or z.Value = "P" Then
Zeile = z.Row
Prio = True
Exit For
End If
Next
End Select
If Prio = True Then
'--- prüfen, ob eruierte Zeile der obersten Zeile Bahnhof entspricht
If IsEmpty(.Cells(Zeile, 1)) And IsEmpty(.Cells(Zeile, 2)) = True Then
Zeile = .Cells(Zeile, 1).End(xlUp).Row
End If
'----- Zeilen kopieren
'--- bestimmt letzte Zeile Tabelle zum Einfügen
intLastRowPaste = Worksheets(Blattname).Cells(Rows.Count, Spalte_Nutzlänge).End(xlUp).Row + 1
.Range(.Cells(Zeile, 1), .Cells(ZeileEnd, intlastColumn)).Copy Worksheets(Blattname).Cells(intLastRowPaste, 1)
End If
End If
Application.StatusBar = "Fortschrittskontrolle: " & intLastRow - ZeileEnd - 4
Next
End With
Application.StatusBar = False
End Sub Das Makro erstellt eine zusätzliche Tabelle, die beim Schliessen mit folgendem Makro gelöscht _
wird:


Private Sub Workbook_BeforeClose(Cancel As Boolean)
GetMoreSpeed True
'unnötige Blätter löschen
If Worksheets.Count > 4 Then
For Each sh In ThisWorkbook.Worksheets
If sh.Name  "Muster" Then sh.Delete
Next
End If
End Sub

Kann mir jemand sagen, wie ich das beheben kann? Übirgens, das Makro läuft fehlerlos.
Vielen Dank und Gruss
Gregor

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Das Bild ist zu gross und wird abgeschnitten

06.07.2016 16:29:27

Gregor

AW: Das Bild ist zu gross und wird abgeschnitten

06.07.2016 16:29:27

Gregor

Hallo zusammen
Ich habe im Internet folgende interessante Lösung gefunden:
Problem:
Beim schließen von Excel mittels Makro bekommt man den Hinweis: "Bild zu groß, kann nicht abgeschnitten werden".
Das Problem ist die Zwischenablage, die noch "voll" ist.
Man möchte nun mittels VBA-Makro die Zwischenablage löschen
Lösung:
Folgendes Makro in den Bereich "Arbeitsmappe" kopieren

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ClearClipboard
End Sub

Public Sub ClearClipboard()
OpenClipboard 0&
EmptyClipboard
CloseClipboard
End Sub

Unter "Dekleration" im Modul:
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard& Lib "user32" ()
Danke und Gruss
Gregor

Infobox / Tutorial

Excel: Bild ist zu groß und wird abgeschnitten – Lösungen und Tipps

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Um das Problem "Das Bild ist zu groß und wird abgeschnitten" in Excel zu beheben, kannst Du die folgenden Schritte ausführen:

Öffne die Excel-Datei, in der das Problem auftritt.
Navigiere zum VBA-Editor, indem Du ALT + F11 drückst.
Füge ein neues Modul hinzu:
- Rechtsklick auf „VBAProject (DeinDokument)“ > Einfügen > Modul.

Kopiere und füge den folgenden Code in das Modul ein:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   ClearClipboard
End Sub

Public Sub ClearClipboard()
   OpenClipboard 0
   EmptyClipboard
   CloseClipboard
End Sub

Füge die Deklarationen für die Clipboard-Funktionen hinzu:

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Speichere die Änderungen und schließe den VBA-Editor.
Schließe die Excel-Datei und prüfe, ob das Problem weiterhin besteht.

Häufige Fehler und Lösungen

Problem: Das Bild wird beim Schließen abgeschnitten.

Lösung: Oftmals liegt das Problem an einer vollen Zwischenablage. Das oben genannte Makro zur Bereinigung der Zwischenablage sollte dies beheben.

Problem: Fehlermeldung beim Ausführen eines Makros.

Lösung: Stelle sicher, dass Du alle erforderlichen Variablen deklariert hast und dass Dein Makro keine Fehler enthält. Füge On Error GoTo-Anweisungen hinzu, um Fehler besser zu handhaben.

Alternative Methoden

Eine alternative Methode zur Behebung des Problems "Das Bild ist zu groß und wird abgeschnitten" ist, die Größe der Bilder in Excel manuell anzupassen:

Selektiere das Bild.
Klicke mit der rechten Maustaste und wähle „Größe und Eigenschaften“.
Passen die Höhe und Breite an, um sicherzustellen, dass das Bild in die Zelle passt oder nicht über den Bildschirm hinausgeht.

Praktische Beispiele

Hier sind einige praktische Beispiele, wie Du die beschriebenen Lösungen umsetzen kannst:

Beispiel 1: Wenn Du ein Bild aus der Zwischenablage eingefügt hast und das Bild zu groß ist, führe das Makro ClearClipboard aus, um die Zwischenablage zu leeren, bevor Du das Bild erneut einfügst.
Beispiel 2: Beim Erstellen einer Präsentation in Excel kann es hilfreich sein, die Bildgröße sofort anzupassen. Stelle sicher, dass das Bild beim Einfügen nicht über die Grenzen der Arbeitsblätter hinausgeht.

Tipps für Profis

Verwende die „Größe anpassen“-Funktion: Nutze die Funktion „Größe anpassen“, um sicherzustellen, dass Bilder immer richtig in Zellen passen.
Kontrolliere, welche Bilder Du einfügst: Achte darauf, dass die Bildauflösung nicht unnötig hoch ist, um Probleme mit der Anzeige zu vermeiden.
Automatisiere die Bereinigung: Integriere den Clipboard-Reiniger in Deine Arbeitsmappen, um zukünftige Probleme mit dem Bildschirmausschnitt zu vermeiden.

FAQ: Häufige Fragen

1. Warum erscheint die Fehlermeldung "Das Bild ist zu groß und wird abgeschnitten"? Die Fehlermeldung tritt auf, wenn ein Bild in Excel größer ist als der verfügbare Platz in der Arbeitsmappe oder wenn die Zwischenablage Probleme verursacht.

2. Wie kann ich die Größe eines Bildes in Excel anpassen? Du kannst die Größe eines Bildes anpassen, indem Du es auswählst und die Ecken ziehst oder die spezifischen Maße im Menü „Größe und Eigenschaften“ eingibst.

3. Was kann ich tun, wenn das Problem weiterhin besteht? Wenn das Problem weiterhin besteht, überprüfe alle Makros, die Du verwendest, und stelle sicher, dass keine anderen Excel-Add-Ins das Verhalten beeinflussen.

Beliebteste Forumthreads (12 Monate)

Das Bild ist zu gross und wird abgeschnitten

Forumthread: Das Bild ist zu gross und wird abgeschnitten

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Excel: Bild ist zu groß und wird abgeschnitten – Lösungen und Tipps

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread