Fotos anzeigen 2007 vs 2013

Hallo,
eine Frage vorab:
Warum gibt es keinen Button "Code einfügen" bei der Beitragserstellung, bei Antworten jedoch schon?
Ok, nun zum eigentlichen Problem. Dieser Code läuft unter Excel2003 und 2007 (32 Bit) perfekt. Bildnummer in F3 auswählen und Bild wird ab Zelle I8 eingefügt.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dateiname As String
Dim Pfad As String
If Not Intersect(Target, Range("F3,Z7")) Is Nothing Then
ActiveSheet.Unprotect Password:="test"
ActiveSheet.DrawingObjects.Delete
If Range("Z7") = "ja" Then
Pfad = ThisWorkbook.Path & "\Sonderfundbilder\"
Dateiname = Dir(Pfad & Format(Range("F3").Value, "0000") & "*")
If Dateiname  "" Then
ActiveSheet.Pictures.Insert(Pfad & Dateiname).Select
With Selection
.Top = Rows(18).Top
.Left = Columns(9).Left
.ShapeRange.LockAspectRatio = msoFalse
.Height = 400
.Width = 400
End With
End If
End If
End If
ActiveSheet.Protect Password:="test"
ActiveSheet.EnableSelection = xlUnlockedCells
Range("F3").Select
End Sub

In Excel 2013 (64 Bit) jedoch verschiebt Excel unmotiviert die Bilder.
Die 500ter Bildnummern landen bei F5 und die 1000ter bei F3 (die Nummern sind nur Bsp., hab nicht alle getestet). Die Bilder werden korrekt wiedergegeben, also ausgewählte Nummer passt zum Bild.
Liegt es am Code, dass da ein Element nicht von Excel2013 richtig interpretiert wird?
Und noch ne Frage:

ActiveSheet.DrawingObjects.Delete

löscht die Bilder, leider auch die Bildlaufleiste (Formularsteuerelement) , was ich aber benötige. Hatte es schon mit if then versucht, bin da aber ebenso gescheitert.
Wäre für Hilfe und Ratschläge sehr dankbar.
Viele Grüße
Hopps

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim pic As Object Dim Dateiname As String, Pfad As String If Not Intersect(Target, Range("F3,H3")) Is Nothing Then ActiveSheet.Unprotect Password:="test" ActiveSheet.DrawingObjects.Delete If Range("H3") = "ja" Then Pfad = "F:\Daten\Downloads\2\" Dateiname = Dir(Pfad & Format(Range("F3").Value, "00000") & "*") If Dateiname "" Then Set pic = ActiveSheet.Pictures.Insert(Pfad & Dateiname) With pic .Top = Rows(18).Top .Left = Columns(9).Left .ShapeRange.LockAspectRatio = msoFalse .Height = 400 .Width = 400 End With End If End If End If Set pic = Nothing ActiveSheet.Protect Password:="test" ActiveSheet.EnableSelection = xlUnlockedCells Range("F3").Select End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Const Pfad As String = "F:\Daten\Downloads\2\" Dim pic As Shape Dim Dateiname As String If Not Intersect(Target, Range("F3,H3")) Is Nothing Then Unprotect Password:="test" For Each pic In Shapes With pic If .Type = msoPicture Or _ .Type = msoLinkedPicture Then Call .Delete End With Next If Range("H3").Value = "ja" Then Dateiname = Dir(Pfad & Format(Range("F3").Value, "00000") & "*") If Dateiname "" Then Set pic = Pictures.Insert(Pfad & Dateiname) With pic .Top = Rows(18).Top .Left = Columns(9).Left .ShapeRange.LockAspectRatio = msoFalse .Height = 400 .Width = 400 End With Set pic = Nothing End If End If End If Protect Password:="test" EnableSelection = xlUnlockedCells Range("F3").Select End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'Dim pic As Shape Dim Dateiname As String Dim Pfad As String If Not Intersect(Target, Range("F3,Z7")) Is Nothing Then Unprotect Password:="test" For Each pic In Shapes With pic If .Type = msoPicture Or _ .Type = msoLinkedPicture Then Call .Delete End With Next If Range("Z7") = "ja" Then Pfad = ThisWorkbook.Path & "\Bilder\" Dateiname = Dir(Pfad & Format(Range("F3").Value, "0000") & "*") If Dateiname "" Then Set pic = ActiveSheet.Pictures.Insert(Pfad & Dateiname) With pic .Top = Rows(18).Top .Left = Columns(9).Left .ShapeRange.LockAspectRatio = msoFalse .Height = 400 .Width = 400 End With Set pic = Nothing End If End If End If ActiveSheet.Protect Password:="test" ActiveSheet.EnableSelection = xlUnlockedCells Range("F3").Select End Sub

Hallo Hopps,
bei eine ScrollBar müssen wir das anders machen. Lösche das Makro im Modul der Tabelle. Füge ein Standardmodul ein (Menüleiste im VBA-Editor - Einfügen - Modul). Füge in dieses Modul folgenden Code ein. Rechtsklick auf die ScrollBar - Makro zuweisen. Im Dialog wählst due den Namen meines Makros (ScrollBarChange) aus. Dann kannst du auch die Zellverknüpfung löschen, die benötigen wir nicht.

Option Explicit

Public Sub ScrollBarChange()
    Dim Dateiname As String
    Dim Pfad As String
    Dim Bild As Picture
    Dim objShape As Shape
    With Worksheets("Tabelle1")
        .Unprotect Password:="test"
        For Each objShape In .Shapes
            With objShape
                If .Type = msoPicture Or _
                    .Type = msoLinkedPicture Then Call .Delete
            End With
        Next
        If .Range("Z7").Value = "ja" Then
            Pfad = ThisWorkbook.Path & "\Bilder\"
            Dateiname = Dir$(Pfad & Format$(.Shapes(Application.Caller) _
                .OLEFormat.Object.Value, "0000") & "*")
            If Dateiname <> "" Then
                Set Bild = .Pictures.Insert(Pfad & Dateiname)
                Bild.Top = .Rows(18).Top
                Bild.Left = .Columns(9).Left
                Bild.ShapeRange.LockAspectRatio = msoFalse
                Bild.Height = 400
                Bild.Width = 400
                Set Bild = Nothing
            End If
        End If
        .Protect Password:="test"
        .EnableSelection = xlUnlockedCells
        .Range("F3").Select
    End With
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fotos anzeigen 2007 vs 2013

6 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)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread