Bild mit laufender Nummer einfügen

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

Betrifft: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 12:27:48

So, ich hoffe, mein leztes Problem für heute:
Ich habe eine Tabelle mit verschiedenen Daten (Artikelnummer, EAN etc.). Bei einem Doppelklick auf eine Zeile soll ein Bild eingefügt werden. Die Bilddatei ist mit der Artikelnummer in Spalte A benannt. Zudem soll das Bild mit einer laufenden Nummer versehen werden (per Textbox und Gruppierung?)
Ich habe diese Frage bereits vor einigen Tagen gestellt und von HaJo einen Verweis auf seine Seite bekommen. Leider bin ich da nicht fündig geworden, insbesondere die Nummerierung bereitet mit Kopfzerbrechen.
Vieleicht hat jemand einen Vorschlag.
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 12:59:05
Hallo Carsten,
da sind doch zuerst ein paar Fragen offen.


  1. Steht in A der kompltette Pfad zu Bilddatei, oder nur der Name?

  2. Wenn nur der Dateiname in A steht, wie lautet der Pfad, bzw. wo steht dieser?

  3. In welche Zelle soll das Bild eingefügt werden?

  4. Wie groß soll das eingefügte Bild sein? Originalgröße? An die Zelle (Höhe oder Breite) angepasst?

  5. Wo startet die Nummerierung und wie soll diese aussehen?

  6. Wenn ein Bild gelöscht wird, soll die Nummerierung mit der höchsten Nummer vorgesetzt werden, oder sollen die fehlenden Nummern eingefügt werden?

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 13:36:04
Hallo Sepp,
zu 1) Es steht nur die Artikelnummer in Spalte A. Die Bilddatei trägt dann den Namen "Artikelnummer.png"
zu 2) Im Moment f:\Bilder
zu 3) Die Zelle ist egal, da das Bild nach dem Einfügen händisch an den korrekten Platz geschoben wird.
zu 4) Das Bild soll in Originalgröße eingefügt werden (und wenn möglich sogar gegen Änderungen geschützt)
zu 5) Bei 1 soll es losgehen und laufend nummeriert werden. Die Zahl soll möglichst klein (Größe 8 oder 10)am unteren Bildrand, mittig oder linksbündig angesetzt werden.
zu 6) Wenn ein Bild gelöscht wird, sollte das immer nur das zuletzt eingefügte Bild betreffen, daher kann mit der nächsten Nummer fortgesetzt werden.
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 15:11:07
Hallo Carsten,
probier mal.

' **********************************************************************
' Modul: Tabelle4 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Const cstrPath As String = "F:\Bilder" 'Pfad
Private Const cstrExt As String = ".png" 'Erweiterung

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFile As String

strFile = cstrPath & IIf(Right(cstrPath, 1) <> "\", "\", "") & Cells(Target.Row, 1).Text & cstrExt

If Dir(strFile, vbNormal) <> "" Then
  Cancel = True
  Call insertPicture(strFile, Target)
End If
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

'Code zum Auslesen der Bildgröße aus "Online Excel Forum" - http://www.online-excel.de/
'Postet by Nepumuk, 20/06/05
'Geändert von J.Ehrensberger 08/02/06
Private Declare Function CreateIC Lib "GDI32.dll" Alias "CreateICA" (ByVal lpDriverName As String, _
  ByVal lpDeviceName As String, ByVal lpOutput As String, ByRef lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "GDI32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As _
  Long
Private Declare Function MulDiv Lib "Kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, _
  ByVal nDenominator As Long) As Long


Private Const LOGPIXELSX = 88&
Private Const LOGPIXELSY = 90&
Private Const HimetricInch = 2540&

Sub insertPicture(strFilename As String, Target As Range)
Dim objPic As Shape, objText As Shape, objGroup As Shape
Dim lngCount As Long
Dim dblw As Double, dblH As Double

If Dir(strFilename, vbNormal) <> "" Then
  For Each objText In ActiveSheet.Shapes
    If objText.Name Like "group_*" Then
      lngCount = Application.Max(lngCount, Clng(Split(objText.Name, "_")(1)))
    End If
  Next
  lngCount = lngCount + 1
  GetImageSize strFilename, dblw, dblH
  Set objPic = ActiveSheet.Shapes.AddPicture(strFilename, msoFalse, msoTrue, Target.Left, Target.Top + 1, dblw, dblH)
  With objPic
    .LockAspectRatio = True
    .Line.Visible = msoFalse
    .OnAction = "dummy"
  End With
  Set objText = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, Target.Left, Target.Top + objPic.Height - 3, objPic.Width, 10)
  With objText
    .TextFrame.Characters.Font.Size = 8
    .TextFrame.Characters.Text = lngCount
    .TextFrame.HorizontalAlignment = xlHAlignCenter
    .TextFrame.VerticalAlignment = xlVAlignCenter
    .Line.Visible = msoFalse
    .OnAction = "dummy"
  End With
  Set objGroup = ActiveSheet.Shapes.Range(Array(objPic.Name, objText.Name)).Group
  objGroup.Name = "group_" & lngCount
End If

Set objPic = Nothing
Set objText = Nothing
Set objGroup = Nothing
End Sub

Sub dummy()
'..
End Sub

Private Function GetImageSize(ByVal strPicturePath As String, ByRef dblWidth As Double, ByRef dblHeight As Double) As Long
Dim MyPicture As StdPicture
On Error GoTo ErrExit
Set MyPicture = LoadPicture(strPicturePath)
If Not MyPicture Is Nothing Then
  GetImageSize = -1
  dblWidth = HimetricToPixelsX(MyPicture.Width)
  dblHeight = HimetricToPixelsY(MyPicture.Height)
End If
ErrExit:
Err.Clear
On Error GoTo 0
Set MyPicture = Nothing
End Function

Private Function HimetricToPixelsX(ByVal inHimetric As Long) As Long
HimetricToPixelsX = ConvertPixelHimetric(inHimetric, True, True)
End Function

Private Function HimetricToPixelsY(ByVal inHimetric As Long) As Long
HimetricToPixelsY = ConvertPixelHimetric(inHimetric, True, False)
End Function

Private Function ConvertPixelHimetric(ByVal inValue As Long, _
  ByVal ToPix As Boolean, inXAxis As Boolean) As Long

Dim TempIC As Long, GDCFlag As Long
TempIC = CreateIC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
If (TempIC) Then
  If (inXAxis) Then GDCFlag = LOGPIXELSX Else GDCFlag = LOGPIXELSY
  If (ToPix) Then ConvertPixelHimetric = MulDiv(inValue, _
    GetDeviceCaps(TempIC, GDCFlag), HimetricInch) _
  Else ConvertPixelHimetric = MulDiv(inValue, _
    HimetricInch, GetDeviceCaps(TempIC, GDCFlag))
  Call DeleteDC(TempIC)
End If
End Function

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 15:27:48
Nach der zweiten "Option Explicit" bleibt es hängen:
Fehler beim Kompilieren, nach End Sub, End Function oder End Property können nur Kommentare stehen.

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 15:36:34
Hallo Carsten,
du hast aber schon beachtet, dass der erste Code in das Modul der Tabelle gehört, der zweite in ein allgemeines Modul! Steht auch im Code!

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 15:47:24
Sorry, da hab ich nicht aufgepasst.
Jetzt kommt zwar keine Fehlermeldung mehr, es passiert aber auch sonst nichts.

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 17:01:24
Hallo Carsten,
also wenn in Spalte A die Artikelnummer steht und der Pfad im Modul der Tabelle auch stimmt, dann weiß ich nicht, warum es bei dir nicht läuft, bei mir klappt es tadellos.
Du hast den ersten Code schon im Modul jener Tabelle, in welcher du den Doppelklick ausführst?

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 17:11:58
Hallo Sepp,
hab's mir nochmal genau angeschaut (in 200%).
Es wird kein Bild eingefügt, es taucht lediglich ein Textfeld mit einer fortlaufenden Nummer innerhalb der Zelle auf in die geklickt wird.
Sorry, aber das fällt kaum auf, daher hab ich es übersehen.
Der erste Teil des Codes ist übrigens im Tabellenmodul.

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 17:16:00
Hallo Carsten,
dann sind deine Bilder unsichtbar oder 0 x 0 Pixel groß! Wenn der Text eingefügt wird, dann wird auch das Bild eingefügt.
Steht der zweite Code in einem allgemeinem Modul? Sonst geht es auch nicht.

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 17:33:59
Hallo Sepp,
ich erklär mal wie ich's gemacht hab (für VBA-Daus):
1. Rechtsklick auf Tabellenreiter - Code anzeigen - Ersten Teil des Codes einfügen
2. Mit ALT+F11 in den VBA-Editor - Einfügen - Modul - Zweiten Teil des Codes einfügen
Ich hoffe mal, dass ich irgendetwas vergessen bzw. falsch gemacht habe.
Die Bilder sind definitiv vorhanden, sichtbar und groß genug.
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 20:00:30
Hallo Carsten,
stimmt der Pfad zu den Bildern? Stimmt die Erweiterung?

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 20:16:56
Hallo Sepp,
ich hab beides doppelt und dreifach geprüft. Hab andere Bilder probiert. Hat alles nicht geholfen.
Ich bin mit dem Debugger durchgegangen und hab mal eine Datei angehängt in der ich den Ablauf rot markiert habe. Vielleicht hilft Dir das weiter.
https://www.herber.de/bbs/user/101045.doc

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 20:55:10
Hallo Carsten,
den Code kenne ich schon! Besser wäre es, deine xl-Datei hochzuladen.

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 26.10.2015 21:14:18
Hallo Sepp,
hier eine Muster-Datei.
https://www.herber.de/bbs/user/101049.xls
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 26.10.2015 22:03:30
Hallo Carsten,
klappt wie erwartet! Lautet der Pfad wirklich "F:\Bilder Sonax" oder doch "F:\Bilder\Sonax" ?

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 27.10.2015 07:55:35
Hallo Sepp,
der Pfad ist korrekt. Ich hab die Datei jetzt auch mal auf dem Laptop unter Excel 2007 getestet. Mit dem gleichen Ergebnis. Das Textfeld wird eingefügt aber kein Bild...
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 27.10.2015 17:53:53
Hallo Carsten,
nicht nachvollziehbar.
Kannst du mal eines der Bilder (gezipt) hochladen?
Wenn du die Gruppierung mit rechts anklickst und in den Optionen auf "Gruppierung aufheben" gehst, was siehst du dann?

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 27.10.2015 18:01:17
Hallo Sepp, hier das Bild.
https://www.herber.de/bbs/user/101078.zip
Wenn ich die Gruppierung aufhebe passiert nichts. Es ist quasi als wenn ich nur ein einzelnes Objekt gruppiert hätte.
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 27.10.2015 19:14:39
Hallo Carsten,
das Problem liegt an deinen Bildern! Das sind keine echten PNG-Dateien, bei mir klappt es mit png tadellos, mit deinem Bild allerdings nicht, weil die Bildgröße nicht ermittelt werden kann.
Wenn ich deine png in jpg umbenenne, dann läuft es auch mit deinem Bild.
Wenn ich den Code im Tabellenmodul so anpasse, dann läuft es auch mit deinem .png.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************


Option Explicit

Private Const cstrPath As String = "f:\Bilder Sonax" 'Pfad
Private Const cstrExt As String = ".png" 'Erweiterung

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFile As String, lngRow As Long

strFile = cstrPath & IIf(Right(cstrPath, 1) <> "\", "\", "") & Cells(Target.Row, 1).Text & cstrExt
If Application.CountA(Rows(Target.Row)) > 0 Then
  Cancel = True
  With Sheets("Tabelle3") 'Zieltabelle - Name anpassen!
    lngRow = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
    .Cells(lngRow, 1) = Application.Max(.Columns(1)) + 1
    Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Copy .Cells(lngRow, 2)
  End With
End If

If Dir(strFile, vbNormal) <> "" Then
  strFile = cstrPath & IIf(Right(cstrPath, 1) <> "\", "\", "") & Dir(strFile, vbNormal)
  Cancel = True
  Call insertPicture(strFile, Target)
End If
End Sub

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 27.10.2015 19:51:16
Hallo Sepp,
ich habe mit allem gerechnet, aber nicht, dass es an den Bildern liegen könnte.
Vielen Dank für deine Mühe. Sollten wir uns mal treffenn hast Du mindestens ein paar Bier gut bei mir.
Eine Frage trotzdem noch. Wozu muss die Bildgröße ermittelt werden?
Gruß
Carsten

Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Sepp
Geschrieben am: 27.10.2015 20:01:03
Hallo Carsten,
weil beim Einfügen des Bildes dessen Dimension angegeben werden muss.
Wenn man ein Bild direkt einfügt, dann braucht man das nicht, aber wir arbeiten mit Shapes und da muss man schon im Code die Dimensionen angeben. Die InsertPicture-Methode führt bei den neueren XL-Versionen dazu, das nur eine Verknüpfung zum Bild eingefügt wird, aber nicht das Bild selber.
Klappt es denn nun?

Gruß Sepp


Bild

Betrifft: AW: Bild mit laufender Nummer einfügen
von: Carsten
Geschrieben am: 27.10.2015 20:27:33
Ups, hatte ich gar nicht geschrieben...ich habe jetzt mit anderen Bildern getestet und da klappt es. Ich werde also nun die Bilder entsprechend anpassen und dann habe ich das was ich brauche.
Nochmal vielen Dank für Deine Hilfe.
Carsten

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bild mit laufender Nummer einfügen"