Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Image
Screenshot zu Image	Image-Seite mit Beispielarbeitsmappe aufrufen

Foto verkleinert einfügen / Chart.Paste Problem

• Foto verkleinert einfügen / Chart.Paste Problem von Roland vom 26.09.2019 17:44:29
• AW: Foto verkleinert einfügen / Chart.Paste Problem - von Nepumuk am 26.09.2019 17:56:54
• Foto verkleinert per WIA - von Nepumuk am 26.09.2019 18:08:15
• AW: Foto verkleinert per WIA - von Roland am 27.09.2019 17:34:18
• AW: Foto verkleinert per WIA - von Roland am 27.09.2019 17:35:03

Betrifft: Foto verkleinert einfügen / Chart.Paste Problem von: Roland
Geschrieben am: 26.09.2019 17:44:29

Hallo Excel-Profis

Mit unten stehendem Code kann der User ein Foto auf seinem Rechner auswählen. Anschließend wird das Foto in einem Diagramm auf die richtige Grösse verkleinert, nach C:\Temp exportiert und auf das Tabellenblatt eingefügt.
Das hat bis Office 2013 einwandfrei funktioniert. Mit Office 365 bleibt das exportierte Bild entweder weiß oder es wird das Wasserzeichen des Charts angezeigt.
Gemäß diversen Forums-Einträgen muss unter Office 365 die ChartArea ja selektiert werden. Das habe ich gemacht. Das Bild wird aber trotzdem nicht angezeigt.
Komischerweise funktioniert das Programm im Debug-Modus (F8).

Kann mir jemand weiterhelfen?

Herzlichen Dank

Gruß, Roland

Option Explicit
Public Const strFilePathBildKlein As String = "C:\temp\TestFoto.jpg"
Public Const strMyPwd As String = "Test"

Sub FotoVerkleinern()
Dim sngWidth, sngHeight As Single
Dim objChart As Chart, objChartObject As ChartObject
Dim strOrgFaktor, strZellenBreite, strFilePath As String
Dim objBild As Object

  strZellenBreite = Range("A5:B5").Width
   
  strFilePath = Application.GetOpenFilename("Only Picture (*.jpg), *.jpg", Title:="Select  _
Picture", MultiSelect:=False)
  
  Set objBild = ActiveSheet.Pictures.Insert(strFilePath)
   
    strOrgFaktor = objBild.Width / objBild.Height
    objBild.Cut
    
    sngWidth = strZellenBreite
    sngHeight = strZellenBreite / strOrgFaktor
    
    Application.ScreenUpdating = False
    Set objChart = Charts.Add
    objChart.Activate
    ActiveWindow.Zoom = 100

    Set objChartObject = objChart.ChartObjects.Add(0, 0, sngWidth, sngHeight)
    
    With objChartObject.Chart
        .ChartArea.Select
        .Paste
        .Export Filename:=strFilePathBildKlein, _
            FilterName:="jpg", Interactive:=False
    End With
    
    Application.DisplayAlerts = False
    objChart.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
Set objBild = Nothing

End Sub

Sub FotoEinfuegen()

Dim str_FotoNummer As String
Dim lng_ScrollPosition As Long

Application.ScreenUpdating = False
ActiveSheet.Unprotect strMyPwd
mdl_Steuerung.FotoVerkleinern


With Tabelle1
    lng_ScrollPosition = ActiveWindow.ScrollRow
    Select Case Application.Caller
        Case "pic_Foto1"
            str_FotoNummer = "pic_Foto1"
        Case "pic_Foto2"
            str_FotoNummer = "pic_Foto2"
        Case "pic_Foto3"
            str_FotoNummer = "pic_Foto3"
        Case Else
            ActiveSheet.Protect strMyPwd
            Exit Sub
    End Select
    
    .Shapes(str_FotoNummer).Fill.UserPicture (strFilePathBildKlein)
End With

Kill (strFilePathBildKlein)
ActiveSheet.Protect strMyPwd
ActiveWindow.ScrollRow = lng_ScrollPosition
Application.ScreenUpdating = True
End Sub

Sub FotoEntfernen()

Dim str_FotoNummer As String
Dim lng_ScrollPosition As Long

ActiveSheet.Unprotect strMyPwd

With Tabelle1
    lng_ScrollPosition = ActiveWindow.ScrollRow
    Select Case Application.Caller
        Case "pic_FotoDelete1"
            str_FotoNummer = "pic_Foto1"
        Case "pic_FotoDelete2"
            str_FotoNummer = "pic_Foto2"
        Case "pic_FotoDelete3"
            str_FotoNummer = "pic_Foto3"
        Case Else
            ActiveSheet.Protect strMyPwd
            Exit Sub
    End Select
    
    .Shapes(str_FotoNummer).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .Shapes(str_FotoNummer).Fill.Transparency = 1
End With

ActiveSheet.Protect strMyPwd
ActiveWindow.ScrollRow = lng_ScrollPosition

End Sub

Betrifft: AW: Foto verkleinert einfügen / Chart.Paste Problem von: Nepumuk
Geschrieben am: 26.09.2019 17:56:54

Hallo Roland,

versuch es mal so:

Gruß
Nepumuk

Betrifft: Foto verkleinert per WIA von: Nepumuk
Geschrieben am: 26.09.2019 18:08:15

Hallo Roland,

das verkleinern geht so eleganter:

Gruß
Nepumuk

Betrifft: AW: Foto verkleinert per WIA von: Roland
Geschrieben am: 27.09.2019 17:34:18

Hallo Nepumuk

Besten Dank für deine schnelle Antwort und sorry, dass ich erst jetzt schreibe, hatte noch andere Sachen um die Ohren.

Deinen Vorschlag mit .Parent.Activate habe ich versucht geht leider auch nicht.
Ich habe noch andere Sachen probiert aber das Bild ist und bleibt einfach weiss. Wissen vermutlich nur die "Microsoft-Götter" warum. ;-)

Ich habe dein Vorschlag das Bild anders zu verkleinern aufgenommen und meinen Bedürfnissen angepasst. Nun funktioniert alles einwandfrei (halt ohne Chart ist in meinem Fall ja auch nicht nötig)

Herzlichen Dank für deine Bemühungen

Gruss, Roland

Betrifft: AW: Foto verkleinert per WIA von: Roland
Geschrieben am: 27.09.2019 17:35:03

Hallo Nepumuk

Besten Dank für deine schnelle Antwort und sorry, dass ich erst jetzt schreibe, hatte noch andere Sachen um die Ohren.

Deinen Vorschlag mit .Parent.Activate habe ich versucht geht leider auch nicht.
Ich habe noch andere Sachen probiert aber das Bild ist und bleibt einfach weiss. Wissen vermutlich nur die "Microsoft-Götter" warum. ;-)

Ich habe dein Vorschlag das Bild anders zu verkleinern aufgenommen und meinen Bedürfnissen angepasst. Nun funktioniert alles einwandfrei (halt ohne Chart ist in meinem Fall ja auch nicht nötig)

Herzlichen Dank für deine Bemühungen

Gruss, Roland

Beiträge aus dem Excel-Forum zum Thema "Foto verkleinert einfügen / Chart.Paste Problem"