Excel VBA

Dieses Thema Excel VBA im Forum "Microsoft Office Suite" wurde erstellt von schlemmer_horst, 23. Mai 2007.

Thema: Excel VBA kann man ein bild mit VBA in eine Excel tabelle einbinden? (nähere infos gibts wenn jmd mit ja antwortet :) ) gruss...

  1. kann man ein bild mit VBA in eine Excel tabelle einbinden?
    (nähere infos gibts wenn jmd mit ja antwortet :) )

    gruss horst
     
  2. hi matjes
    danke für die antwort
    jedoch ist es nun so das ich eine user form erstellt habe
    dort gibt es einen schaltfläche geheimhaltung ja
    nein

    wenn ich das kontrollkästchen ja anklicke, dann soll er mir das bild reinladen.
    und zwar nicht auf die user form sondern in das excel blatt selber.

    kennste da noch eine lösung? :)
     
  3. Hallo schlemmer_horst,

    ist nur die Frage wo das Bild reingeladen werden soll:

    1. Frage: welches Arbeitsblatt ?
    - das aktuelle ?
    2. Frage: welche Zelle, also Zeile,Spalte ?
    - müßte man irgendwie in Makro feststellen können,
    z.B. Namen suchen in Spalte -> Zeile
    und Spalte für Eintrag fest vorgegeben

    Gruß Matjes :)
     
  4. also ist so das die user form sich beim start öffnet
    dann sollte es sobald die user form komp. ausgefüllt wird (jetzt egtl sekundär wichtig) und mit ok bestätigt wird auf das aktuelle blatt eigefügt werden.
    zelle a1

    bräucht jetzt also ein makro das ich auf die schaltfläche der userform legen könnte. :)
    falls du mal zeit uns lust hast :knuppel2: ;D
     
  5. Hallo schlemmer_horst,

    versuchs mal mit folgendem Makro.

    Die Konstanten
      Const cFULLPATH_BILD = C:\Test\TestBild.jpg
      Const c_MAXBILDHOEHE = 150-> max. Bildhöhe in Punkten
    müßtest du anpassen.

    Wenn das Bild nicht fest ist, kannst du in der Zeile
    s_DateinameFull = cFULLPATH_BILD
    statt der konstanten den vollen Pfad angeben.

    Gruß Matjes :)

    Code:
    '***********************************************************
    Sub Excel_BildEinfuegenInZelleA1()
     ->Das Makro
     ->a) fügt in die Zelle A1 des aktuellen Blattes ein Bild ein,
     ->   das an diese Zelle gebunden wird.
     ->b) Zeilenhöhe wird entsprechend der Bildhöhe gesetzt.
     ->   Wird dabei eine maximale Höhe c_MAXBILDHOEHE überschritten,
     ->   wird die Bildhöhe darauf reduziert.
     ->c) Spalte der betreffenden Zelle wird auf die sich dann ergebende Bildbreite erweitert,
     ->   wenn das Bild nach der Skalierung breiter als die Spalte ist.
     ->
     ->Voraussetzung:
     -> - die Zelle A1 darf nicht bereits ein Bild enthalten
      
      Const cFULLPATH_BILD = C:\Test\TestBild.jpg
      Const c_MAXBILDHOEHE = 150-> max. Bildhöhe in Punkten
    
      Const c_SICHERHEITSFAKTOR_BILDBREITE = 1.02
    
      Dim ws As Worksheet, o_Bild As Picture, sh As Shape
      Dim s_DateinameFull As String, b_IstBild As Boolean
      Dim x1 As Long, l_Spalte As Long, lRow As Long, lCol As Long
      Dim l_faktor As Double, d_ColWidth As Double
      Dim d_colWidth_Pkt As Double, d_BildWidth_Pkt As Double
      Dim lCount As Long
      
     ->voller Pfad zum Bild
      s_DateinameFull = cFULLPATH_BILD
      If Dir(s_DateinameFull, vbNormal) =  Then
        MsgBox Bild-> & s_DateinameFull &-> nicht vorhanden.
        GoTo AUFRAEUMEN
      End If
      
     ->*** na dann an die Arbeit
      Set ws = ActiveSheet
      lRow = ActiveSheet.Range(A1).Row
      lCol = ActiveSheet.Range(A1).Column
      
     ->*** pruefen, ob Zelle bereits ein Bild enthält
      On Error Resume Next
      For Each sh In ws.Shapes
        l_Spalte = sh.TopLeftCell.Column
        If Err.Number = 0 Then
          If l_Spalte = lCol Then
            If sh.TopLeftCell.Row = lRow Then
              MsgBox Die selektierte Zelle enthält bereits ein Bild.
              GoTo AUFRAEUMEN
            End If
          End If
        Else
          Err.Clear
        End If
      Next
      On Error GoTo 0
      
     ->alten Zellinhalt entfernen
      ws.Cells(lRow, lCol).Value = 
        
     ->*** Bild eintragen
     ->Zelle markieren, Bild einfügen
      ws.Range(A1).Select
      
      
      On Error Resume Next
      ws.Cells(lRow, lCol).Select
      ws.Pictures.Insert (s_DateinameFull)
      Set o_Bild = ws.Pictures(ws.Pictures.Count)
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox Das Bild  & s_DateinameFull &  konnte nicht eingefügt werden.
        GoTo AUFRAEUMEN
      End If
      On Error GoTo 0
      
      o_Bild.Placement = xlMove->xlFreeFloating
      o_Bild.PrintObject = True
    
     ->Bildhöhe begrenzen
      If o_Bild.Height > c_MAXBILDHOEHE Then
       ->skalieren
        l_faktor = c_MAXBILDHOEHE / o_Bild.Height
        o_Bild.ShapeRange.ScaleWidth l_faktor, msoFalse, msoScaleFromTopLeft
        o_Bild.ShapeRange.ScaleHeight l_faktor, msoFalse, msoScaleFromTopLeft
      End If
    
     ->Zeilenhöhe dem Bild anpassen
      ws.Rows(lRow).RowHeight = o_Bild.Height
    
     ->Breite der Spalte anpassen, wenn Bild breiter als Spalte
      d_ColWidth = ws.Cells(lRow, lCol).ColumnWidth
      d_colWidth_Pkt = ws.Cells(lRow, lCol).Width->in Punkt
      d_BildWidth_Pkt = o_Bild.ShapeRange.Width   'in Punkt
     ->kleiner Koorekturfaktor, damit Bild nicht über den rand hinausschaut
      d_BildWidth_Pkt = d_BildWidth_Pkt * c_SICHERHEITSFAKTOR_BILDBREITE
     ->Bild breiter als Spalte - > Spalte auf Bild-Breite
      If d_BildWidth_Pkt > d_colWidth_Pkt Then
    
       ->Bilder dieser Spalte auf xlMove, damit sie nicht verzerrt werden
        On Error Resume Next
        For Each sh In ws.Shapes
          l_Spalte = sh.TopLeftCell.Column
          If Err.Number = 0 Then
            If l_Spalte = lCol Then sh.Placement = xlMove
          Else
            Err.Clear
          End If
        Next
        On Error GoTo 0
    
       ->Splate Breite anpassen
        d_ColWidth = d_BildWidth_Pkt / d_colWidth_Pkt * d_ColWidth * c_SICHERHEITSFAKTOR_BILDBREITE
        ws.Columns(lCol).ColumnWidth = d_ColWidth
    
       ->Bilder dieser Spalte wieder auf xlMoveAndSize
        On Error Resume Next
        For Each sh In ws.Shapes
          l_Spalte = sh.TopLeftCell.Column
          If Err.Number = 0 Then
            If l_Spalte = lCol Then
              sh.Placement = xlMoveAndSize
            End If
          Else
            Err.Clear
          End If
        Next
        On Error GoTo 0
    
      End If
    
     ->Um Bild mit Spalte ausblenden zu können, Bild mit Zelle verbinden
      o_Bild.Placement = xlMoveAndSize
    
    AUFRAEUMEN:
      Set ws = Nothing: Set o_Bild = Nothing: Set sh = Nothing
    End Sub
     
Die Seite wird geladen...

Excel VBA - Ähnliche Themen

Forum Datum
Excel-Feature gesucht Microsoft Office Suite 11. Okt. 2016
Excel Tabelle Werte zu ordnen Microsoft Office Suite 23. Sep. 2016
Excel: Bereiche auf 'leer' Überprüfen Microsoft Office Suite 15. Sep. 2016
Import Datensatz inkl = und - Zeichen in Excel/Libre CALC Software: Empfehlungen, Gesuche & Problemlösungen 20. Mai 2016
Bestimmter User kann seine Excel Dateien nicht mehr direkt öffnen Software: Empfehlungen, Gesuche & Problemlösungen 16. Apr. 2016