grafik wird falsch positioniert

Sub grafikeinfügen() Dim p As Picture Dim S Dim Pfad As String ThisWorkbook.Worksheets("Tabelle1").Activate Pfad = Cells(2, 2) Worksheets("Eingabe").Visible = xlSheetVisible ThisWorkbook.Worksheets("Eingabe").Activate For Each S In ThisWorkbook.Worksheets("Eingabe").Shapes If Not Intersect(S.TopLeftCell, Cells(55, 26)) Is Nothing Then S.Delete Next S On Error GoTo weiter Set p = ActiveSheet.Pictures.Insert(Pfad) p.Left = Range("Z55").Left p.Top = Range("Z55").Top p.Height = 50 'p.Width = 70 weiter: Worksheets("Eingabe").Visible = xlSheetVeryHidden End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Dirk,
ich habe Dein Makro in zwei Funktionen geteilet, eine macht das Loeschen und die andere da sEinfuegen.
Falls ein Fehler auftaucht, wirk ein MEssagebox angezeigt. Hoffe es hilft, gruss dan, cz.
Option Explicit

Public Sub Main()
Dim worksheetEingabe As Worksheet
Set worksheetEingabe = ThisWorkbook.Worksheets("Eingabe")
worksheetEingabe.Visible = xlSheetVisible
worksheetEingabe.Activate
If (DeleteShapesIfIntersect(worksheetEingabe)  False) Then
Call grafikeinfügen(worksheetEingabe)
End If
End Sub

Private Function DeleteShapesIfIntersect(ByRef worksheetObject As Worksheet) As Boolean: On  _
Error GoTo ErrorHandler
Dim shapeObject As Shape
Dim shapesObjects As Shapes
Set shapesObjects = worksheetObject.Shapes
For Each shapeObject In shapesObjects
If Not Intersect(shapeObject.TopLeftCell, worksheetObject.Cells(55, 26)) Is Nothing Then
shapeObject.Delete
End If
Next shapeObject
DeleteShapesIfIntersect = True
Exit Function
ErrorHandler:
MsgBox "Error in function 'DeleteShapesIfIntersect'", vbCritical, "Error"
End Function

Private Function grafikeinfügen(ByRef worksheetObject As Worksheet): On Error GoTo weiter
Dim pictureObject As Picture
Dim pfad As String
pfad = Worksheets("Tabelle1").Cells(2, 2)
Set pictureObject = worksheetObject.Pictures.Insert(pfad)
With pictureObject
.Left = worksheetObject.Range("Z55").Left
.Top = worksheetObject.Range("Z55").Top
.Height = 50
'p.Width = 70
End With
Exit Function
weiter:
MsgBox "Error in function 'grafikeinfügen'", vbCritical, "Error"
worksheetObject.Visible = xlSheetVeryHidden
End Function

Hi Dirk,
ich kanns nicht erklaeren, ich weiss es auch nicht :-). In dem Code sind aber einpaar Stellen, wo man es anders machen koennete/sollte.
ThisWorkbook.Worksheets("Tabelle1").Activate
Pfad = Cells(2, 2)
Das ist richtig, aber nicht ganz sicher und langsammer. Nicht sicher, weil Cells() so ohne den Worksheet zeigt auf alle Zellen auf dem aktiven Worksheet. Aber der aktive Worksheet kann sich aendern. Deshalb ist es besser immer (fast immer) die Cells() Property auf einen bestimmten Worksheet zeigen lassen, z.B. so:
Worksheets("Test").Cells(1,1) ... hier ist man sicher, dass es sich immer um die Zellen auf dem Worksheet "Test" handelt.
Langsammer weil Excel musst den Worksheet aktivieren und das kostet Zeit. Man muss den Worksheet nicht aktivieren um Zellen-Inhalt lesen zu koennen.
pfad = Worksheets("Test").Cells(1,1).Value ... "Test" muss nicht der aktive Worksheet sein und trozdem wird der pfad Variable richtig initialisiert.
Das selbe gilt fuer dies:
If Not Intersect(S.TopLeftCell, Cells(55, 26)) Is Nothing Then
Hier ist wieder Cells() ohne den 'object qualifier'. Besser (sicherer) waere Worksheet("Test").Cells(55,26).
Und Set p = ActiveSheet.Pictures.Insert(Pfad), hier weare besser ganz genau zu sagen, um welches Worksheet es sich handelt, weil ActiveSheet kann alles moegliche sein. Also wieder Pictures Funktion mit einem bestimmten 'object qualifier' rufen: Worksheets("TEst").Pictures ... so weiss man, dass das Bild genau in den Worksheet "Test" kommen wird.
Sorry fuer mein Deutsch, habe sicher viele Fehler gemacht in dem langen Text :-). Gruss dan, cz.

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

grafik wird falsch positioniert

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread