Bilder über VBA einfügen

[Deko]

Servus Zusammen,

komische Phönomen:
folgender Code zum Bilder einfügen über eine Schaltfäche klappte Jahre lang ohne Probleme:

Code:

Sub Bild1()
Dim varBild As Variant
Dim Zelle As Range
Dim ScaleA As Double

Set Zelle = Range("B318", "U339")
varBild = Application.GetOpenFilename(Title:="Test")

If varBild = False Then Exit Sub
ActiveSheet.Pictures.Insert(varBild).Select
With Selection.ShapeRange
   .Top = Zelle.Top
   .Left = Zelle.Left
   ScaleA = WorksheetFunction.Min(Zelle.Width / .Width, Zelle.Height / .Height)
   .Height = .Height * ScaleA
End With
Selection.Placement = xlMoveAndSize
Selection.PrintObject = True

End Sub

Mittlerweiie, nach ein paar Änderungen am Dokument, bekomm ich allerdings immer einen Laufzeitfehler.
Nach einigem Probieren habe ich den Code wie folgt geändert:

Code:

Sub Bild1()
Dim varBild As Variant
Dim Zelle As Range
Dim ScaleA As Double

Set Zelle = Range("B318", "U339")
varBild = Application.GetOpenFilename(Title:="Test")

If varBild = False Then Exit Sub
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Pictures.Insert(varBild).Select
With Selection.ShapeRange
   .Top = Zelle.Top
   .Left = Zelle.Left
   ScaleA = WorksheetFunction.Min(Zelle.Width / .Width, Zelle.Height / .Height)
   .Height = .Height * ScaleA
End With
Selection.Placement = xlMoveAndSize
Selection.PrintObject = True
ActiveSheet.Protect Password:="1234"
End Sub

Wenn ich das Passwort raus und wieder rein nehme, geht alles wieder.
NUR, früher konnte ich dann noch die eingefügten Bilder löschen und verschieben, das geht jeztzt nicht mehr.
 
Hat jemand eine Idee woran das liegen könnte?
 
MfG
 
Dennis

[MisterBurns]

Hallo Dennis,

keine Ahnung, ob es hilft, aber ersetze mal das

Code:

ActiveSheet.Unprotect

durch

Code:

ActiveSheet.Protect Password:="1234", Userinterfaceonly:=True

Und das

Code:

ActiveSheet.Protect Password:="1234"

am Ende nimmst du raus.

[Deko]

Leider nicht.

Das interessante:

Der erste Code klappt, solange kein Blattschutz aktiv ist, daher der Umweg über das Passwort.

Sobald bei dem ersten Code der Blattschutz altiv ist kommt ein Laufzeitfehler und nix klappt mehr.

[mmat]

Hallo,

da meine Kristallkugel gerade beim polieren ist: :19:

- Welcher Laufzeitfehler tritt auf ? Klartext ?
- in welcher Zeile des Programms tritt dieser auf ?

vg, MM

[Deko]

Ja, das alt bekannte Problem :D

Laufzeitfehler:

Laufzeitfehler 1004

Die Insert-Eigenschaft des Pictures-Objektes kann nicht zugeordnet werden.

In Zeile:

If varBild = False Then Exit Sub
ActiveSheet.Pictures.Insert(varBild).Select
With Selection.ShapeRange

NUR wenn der Blattschutz aktiv ist, ohne läuft alles so durch...

[snb]

Dann: verzichte auf Blattschutz und 'Select' in VBA

Und verwende:

Code:

Sub M_snb()
   With Application.FileDialog(1)
      .FilterIndex = 0
      .InitialFileName = "*.jpg"
      If .Show Then ActiveSheet.Shapes.AddPicture(.SelectedItems(1), False, True, Columns(2).Left, Rows(3).Top, Columns(2).Width, Rows(3).Height).Placement = 1
   End With
End Sub

[mmat]

Hallo,

ich stehe vor einem Rätsel.

die Zeile "ActiveSheet.Unprotect "123"" sollte doch den Blattschutz aufheben, und für den Fall dass das Passwort falsch ist, erfolgt sofort eine entsprechende Fehlermeldung.

Füge folgende Zeilen nach dem unprotect ein:

 Dim s As String
 s = Dir(varbild, vbNormal)
 MsgBox s

Da müsste dann nochmal der einfache Dateiname erscheinen. Du nimmst doch immer das gleiche Bild?

vg, MM

[Deko]

Den Blattschutz brauch ich leider :D

Mit dem 2ten Code klappt ja auch alles...Bild kommt rein und gut ist, nur ich kann es nicht mehr verschieben, das ging aber mal.

Verschieben können muss ich es, da ab un an Bilder eingefügt werden, wo die zuordnung Quer/Hochformat nicht gemacht werden kann, wenn das Foto z.B. "im liegen" aufgenommen worden ist.

[mmat]

Warum hat's vorher nicht geklappt ??

naja, wenn du schieben möchtest, musst du die entsprechende Option beim Schützen des Blatts freischalten. Am besten du machst das mal manuell und guckst dir die Optionen, die es so gibt an.

Ansonsten: wenn Breite : Höhe >1 dann Querformat ansonsten ist das Hochformat. Du könntest anhand dieser Berechnung für die verschiedenen Formate andere Einfügepositionen verwenden.

[snb]

Code:

Sub M_snb()
   With Application.FileDialog(1)
      .FilterIndex = 0
      .InitialFileName = "*.jpg"
      If .Show Then ActiveSheet.Shapes.AddPicture(.SelectedItems(1), 0, True, Columns(2).Left, Rows(3).Top, Columns(2).Width, Rows(3).Height).Placement = 3
   End With
End Sub