Bild in Zelle einfügen und Zeilenhöhe anpassen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Bild in Zelle einfügen und Zeilenhöhe anpassen
von: Felix
Geschrieben am: 06.08.2015 10:48:16

Hallo liebe VBA-Experten,
Ausgangssituation:
Ich habe ein Userform in dem ich verschiedene Eingaben vornehmen kann. Diese werden dann mit einem Command Button automatisch in eine bestimmte leere Zeile (Zeile i) geschrieben, die per Makro gesucht wird. Das funktioniert soweit alles.
Jetzt zu meinem Problem:
Ich will zudem unterhalb der eingefügten Zeile (also i+1) in einer festen Spalte (Spalte C) ein JPG-Bild einfügen (der "Einfügen-Code" sollte also im "CommandButton Code" eingebettet werden).
Die Breite soll idealerweise die Breite der Spalte C haben und die Höhe soll sich im Verhältnis der Originalgrößen anpassen (damit das Bild nicht verzerrt wird). Wenn möglich sollte sich dann die Zeilenhöhe der Zeile i+1 an die Höhe des Bildes anpassen.
Der Pfad/Dateiname der Bilddatei ist bekannt und steht als Text in einer Textbox (Textbox4) im Userform. Falls kein Bild hinzugefügt wird (also Textbox4 = "") soll nichts passieren und die Zeilenhöhe unverändert bleiben.
Dieses Problem übersteigt meine VBA-Kenntnisse (leider) bei weitem und ich bin euch dankbar für eure Hilfe!!
Schöne Grüße Felix

Bild

Betrifft: zeig den Code vom Button! o.T.
von: Sepp
Geschrieben am: 06.08.2015 10:52:40

Gruß Sepp


Bild

Betrifft: AW: zeig den Code vom Button! o.T.
von: Felix
Geschrieben am: 06.08.2015 11:02:55


Private Sub CommandButton1_Click()
Dim start As String
Dim ziel As String
Dim test1 As String
Dim test2 As String
Dim test3 As String
Dim test4 As String
Dim test5 As String
Dim test6 As String
Dim bauteil As String
Dim nr As String
start = "Nr."   'damit wird die Zeile gesucht, in der das Wort "Nr." steht.
i = 1           'Die Zeile danach ist die Zeile, in die der erste Schaden geschrieben wird.
    Do
    i = i + 1
    ziel = Cells(i, 1).Value
    Loop Until ziel = start
i = i + 1
If WorksheetFunction.CountA(Rows(i)) = 0 Then  'Hier wird geprüft ob die gesucht Zeile leer ist. _
               
    zeileinf1 = i + 1
    ActiveSheet.Cells(zeileinf1, 1).EntireRow.Insert    'Ist die Zeile leer, wird eine Zeile  _
eingefügt,
                                                        'in die der Schaden geschrieben wird
    
        'Die Boxen aus dem Userform werden hier in die entsprechenden Zeilen geschrieben
        Cells(i, 1).Value = Me.ComboBox6.text & "_" & Me.TextBox3.text
        Cells(i, 2).Value = TextBox1.text
        Cells(i, 3).Value = TextBox2.text
        Cells(i, 4).Value = ComboBox1.text
        Cells(i, 5).Value = ComboBox2.text
        Cells(i, 6).Value = ComboBox3.text
        
            
    Else    'Falls die Zeile nicht leer ist wird Schritt für Schritt jede Zeile darunter
            'geprüft ob die 6 zu beschreibenden Spalten leer sind, bis eine Zeile komplett leer  _
ist.
    
    Z = i
    
        Do
            Z = Z + 1
    
            test1 = Cells(Z, 1).Value
            test2 = Cells(Z, 2).Value
            test3 = Cells(Z, 3).Value
            test4 = Cells(Z, 4).Value
            test5 = Cells(Z, 5).Value
            test6 = Cells(Z, 6).Value
    
        Loop Until test1 = "" And test2 = "" And test3 = "" And test4 = "" And test5 = "" And  _
test6= ""
    
    zeileinf2 = Z + 1   'Wenn eine leere Zeile gefunden ist, wird wieder eine neue Zeile
                        'eingefügt, in die der Schaden eingetragen wird.
    ActiveSheet.Cells(zeileinf2, 1).EntireRow.Insert
            'Der Schaden wird hier eingetragen
            Cells(Z, 1).Value = Me.ComboBox6.text & "_" & Me.TextBox3.text
            Cells(Z, 2).Value = TextBox1.text
            Cells(Z, 3).Value = TextBox2.text
            Cells(Z, 4).Value = ComboBox1.text
            Cells(Z, 5).Value = ComboBox2.text
            Cells(Z, 6).Value = ComboBox3.text
End If
         
End  
End Sub

Nicht wundern wenn die Codes sehr laienhaft sind, ich bin noch nicht lange mit VBA unterwegs!
Vielen Dank schon mal

Bild

Betrifft: AW: zeig den Code vom Button! o.T.
von: Sepp
Geschrieben am: 06.08.2015 11:15:14
Hallo Felix,
ungetestet!

Private Sub CommandButton1_Click()

Dim start As String
Dim ziel As String
Dim test1 As String
Dim test2 As String
Dim test3 As String
Dim test4 As String
Dim test5 As String
Dim test6 As String
Dim bauteil As String
Dim nr As String
Dim pic As Picture


start = "Nr." 'damit wird die Zeile gesucht, in der das Wort "Nr." steht.
i = 1 'Die Zeile danach ist die Zeile, in die der erste Schaden geschrieben wird.

Do
  i = i + 1
  ziel = Cells(i, 1).Value
Loop Until ziel = start

i = i + 1

If WorksheetFunction.CountA(Rows(i)) = 0 Then 'Hier wird geprüft ob die gesucht Zeile leer ist. _
    

  
  
  zeileinf1 = i + 1
  ActiveSheet.Cells(zeileinf1, 1).EntireRow.Insert 'Ist die Zeile leer, wird eine Zeile _
    eingefügt,

  'in die der Schaden geschrieben wird
  
  'Die Boxen aus dem Userform werden hier in die entsprechenden Zeilen geschrieben
  Cells(i, 1).Value = Me.ComboBox6.Text & "_" & Me.TextBox3.Text
  Cells(i, 2).Value = TextBox1.Text
  Cells(i, 3).Value = TextBox2.Text
  Cells(i, 4).Value = ComboBox1.Text
  Cells(i, 5).Value = ComboBox2.Text
  Cells(i, 6).Value = ComboBox3.Text
  If Len(TextBox4) Then
    If Dir(TextBox4, vbNormal) <> "" Then
      Set pic = ActiveSheet.Pictures.Insert(TextBox4)
      With pic.ShapeRange
        .LockAspectRatio = msoTrue
        .Left = Cells(i + 1, 3).Left
        .Width = Cells(i + 1, 3).Width
        .Top = Cells(i + 1, 3).Top
        Rows(i + 1).RowHeight = .Height
      End With
      Set pic = Nothing
    End If
  End If
  
Else 'Falls die Zeile nicht leer ist wird Schritt für Schritt jede Zeile darunter
  'geprüft ob die 6 zu beschreibenden Spalten leer sind, bis eine Zeile komplett leer _
    ist.

  
  Z = i
  
  Do
    Z = Z + 1
    
    test1 = Cells(Z, 1).Value
    test2 = Cells(Z, 2).Value
    test3 = Cells(Z, 3).Value
    test4 = Cells(Z, 4).Value
    test5 = Cells(Z, 5).Value
    test6 = Cells(Z, 6).Value
    
  Loop Until test1 = "" And test2 = "" And test3 = "" And test4 = "" And test5 = "" And _
    test6 = ""
  
  zeileinf2 = Z + 1 'Wenn eine leere Zeile gefunden ist, wird wieder eine neue Zeile
  'eingefügt, in die der Schaden eingetragen wird.
  ActiveSheet.Cells(zeileinf2, 1).EntireRow.Insert
  'Der Schaden wird hier eingetragen
  Cells(Z, 1).Value = Me.ComboBox6.Text & "_" & Me.TextBox3.Text
  Cells(Z, 2).Value = TextBox1.Text
  Cells(Z, 3).Value = TextBox2.Text
  Cells(Z, 4).Value = ComboBox1.Text
  Cells(Z, 5).Value = ComboBox2.Text
  Cells(Z, 6).Value = ComboBox3.Text
  
End If


End

End Sub


Gruß Sepp


Bild

Betrifft: AW: zeig den Code vom Button! o.T.
von: Felix
Geschrieben am: 06.08.2015 11:50:36
Funktioniert noch nicht. Bei folgender Zeile springt der Debugger an:
Set pic = ActiveSheet.Pictures.Insert(TextBox4)
Die Fehlermeldung lautet:
Laufzeitfehler 1004:
Die Insert-Eigenschaft des Pictures-Objektes kann nicht zugeordnet werden
Vielleicht stimmt was mit dem Pfad nicht!?
Den suche ich über folgenden Code :

Private Sub CommandButton3_Click()
Dim varDateiname As Variant
    varDateiname = Application.GetOpenFilename
    If TypeName(varDateiname) = "Boolean" Then Exit Sub 'Abbrechen gewählt
    
    TextBox4 = varDateiname
    
End Sub

Und bei der Eingabe "Dim pic As Picture" wird die Eingabe picture nicht blau angezeigt so wie bei String zb. Vielleicht liegt es auch daran.

Bild

Betrifft: mein Fehler!
von: Sepp
Geschrieben am: 06.08.2015 12:19:02
Hallo Felix,
sorry, mein Fehler, es muss natürlich Dim pic As Object" heißen.

Gruß Sepp


Bild

Betrifft: AW: mein Fehler!
von: Felix
Geschrieben am: 06.08.2015 13:07:35
Hallo Sepp,
erstmal Danke für deine Hilfe!
Ich habe die Eingabe geändert, aber das Programm stürzt immernoch an der gleichen Stelle ab.
Gruß Felix

Bild

Betrifft: AW: mein Fehler!
von: Sepp
Geschrieben am: 06.08.2015 13:32:56
Hallo Felix,
was steht den in textBox4 genau?

Gruß Sepp


Bild

Betrifft: AW: mein Fehler!
von: Felix
Geschrieben am: 06.08.2015 13:42:20
Bei dem Beispiel, bei dem mir das Programm abgestürzt ist, habe ich ein Bild vom Desktop verwendet:
Der Pfad lautet:
C:\Users\Felix\Desktop\DSC00317.JPG

Bild

Betrifft: AW: mein Fehler!
von: Sepp
Geschrieben am: 06.08.2015 14:47:06
Hallo Felix,
also bei mur funktioniert der Code einwandfrei, lade deine Datei mal hoch.

Gruß Sepp


Bild

Betrifft: AW: mein Fehler!
von: Felix
Geschrieben am: 11.08.2015 15:24:25
Hallo Sepp,
der Upload hat letzte Woche irgendwie nicht funktioniert (oder ich war unfähig :) )
Hier auf alle Fälle der Link.
https://www.herber.de/bbs/user/99492.xlsm
Danke für deine Hilfe und viele Grüße Felix

Bild

Betrifft: AW: mein Fehler!
von: Sepp
Geschrieben am: 11.08.2015 21:19:56
Hallo Felix,
da hat wohl ein Verweis in der Objekt-Bibliothek gefehlt.
Probier, ob es jetzt läuft.
https://www.herber.de/bbs/user/99497.xlsm

Gruß Sepp


Bild

Betrifft: AW: mein Fehler!
von: Felix
Geschrieben am: 12.08.2015 09:07:03
Guten Morgen Sepp,
funktioniert perfekt! Genauso wie ich mir das vorgestellt habe.
Vielen Dank, da wäre ich selber nie drauf gekommen :)
Viele Grüße Felix

Bild

Betrifft: AW: zeig den Code vom Button! o.T.
von: Felix
Geschrieben am: 06.08.2015 12:00:06
Hilft es dir vielleicht wenn ich dir die Excel-Datei sende?

Bild

Betrifft: Siehe Recherche ! (owT)
von: EtoPHG
Geschrieben am: 06.08.2015 11:11:05


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bild in Zelle einfügen und Zeilenhöhe anpassen"