Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
680to684
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
680to684
680to684
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bild in Tabelle...wir nur ein Wert reingeschrieben

Bild in Tabelle...wir nur ein Wert reingeschrieben
17.10.2005 09:36:30
Peter
Hallo liebe Helfer,
mit untenstehendem Code will ich Urkunden für meinen Verein ausdrucken; die entsprechenden Füllwerte hole ich aus der Tabelle "DBUrkundeGrundkurs". Es klappt auch excellent bis auf eines:
Statt das gewünschte Photo (siehe Zeile: Range("UrkGrundkurs!BeurteilungB") = LoadPicture...usw)in den Bereich zu laden und zu drucken, schreibt er lediglich eine Ziffernfolge rein.....Wer weiss da Abhilfe?

Sub UrkGrundkursDruck()
Application.ScreenUpdating = False
Dim pct As Picture
Dim wks As Worksheet
Dim iRow As Integer
Set wks = Worksheets("DBUrkundeGrundkurs")
iRow = 1
Do Until IsEmpty(wks.Cells(iRow, 1))
Range("UrkGrundkurs!NameB") = wks.Cells(iRow, 2) & " " & wks.Cells(iRow, 1)
Range("UrkGrundkurs!HundB") = wks.Cells(iRow, 3)
Range("UrkGrundkurs!VereinB") = "von " & wks.Cells(iRow, 5) & " bis " & wks.Cells(iRow, 6)
If wks.Cells(iRow, 7).Value = "W" Then
Range("UrkGrundkurs!PunkteB") = "Der Hundeführerin"
Else: Range("UrkGrundkurs!PunkteB") = "Der Hundeführer"
End If
Range("UrkGrundkurs!BeurteilungB") = LoadPicture("c:\UrkundenManager\Bilder\" & wks.Cells(iRow, 4))
Range("UrkGrundkurs!DatumB") = "Schwaig" & ", den " & Date
'Sheets("UrkGrundkurs").PageSetup.PrintQuality = 1200
Sheets("UrkGrundkurs").PrintOut Copies:=1
iRow = iRow + 1
Loop
Application.ScreenUpdating = True
End Sub

Vielen Dank für Eure Mühe
Peter S.

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild in Tabelle...wir nur ein Wert reingeschrieben
17.10.2005 09:38:38
Dr.
Hi,
was steht genau in den Zellen der Spalte 4?
AW: Bild in Tabelle...wir nur ein Wert reingeschrieben
17.10.2005 09:41:46
Peter
Hi Dr.
das ging ja irre schnell, einfach toll.
Also in den Zellen Spalte 4 stehen die Bildbezeichnungen z.B. HundmitFührer.bmp
Grüße
Peter S.
AW: Bild in Tabelle...wir nur ein Wert reingeschrieben
17.10.2005 09:59:54
Dr.
Hi,
meines Wissens kannst Du mit LoadPictures Grafiken nur auf Objekten platzieren.
Bilder in eine Tabelle einzufügen funktioniert mit
ActiveSheet.Pictures.Insert ("c:\....
Ich stelle die Frage trotzdem auf offen.
Lösung gefunden!!!...........Code anbei
17.10.2005 17:25:10
Peter
Hallo Dr und alle anderen,
Ich habe zwar mittlerweile den Code geschafft, um das Bild in die entsprechende Zelle zu laden, bevorzuge aber mittlerweile eine andere Lösung. Ich habe auf dem Sheet "Urkunde" ein Objekt "Bild" platziert, dies hat 2 Vorteile.
1)Mein ursprünglicher Code funktioniert damit
2)Die Platzierung auf dem Tabellenblatt ist einfacher, weil ich den "Bild-Container" natürlich einfach per Maus an die richtige Stelle schieben kann.
Der entsprechende Code sieht nunmehr so aus (und funktioniert bei mir prächtig):

Sub UrkGrundkursDruck()
Application.ScreenUpdating = False
Dim pct As Picture
Dim wks As Worksheet
Dim iRow As Integer
Set wks = Worksheets("DBUrkundeGrundkurs")
iRow = 1
Do Until IsEmpty(wks.Cells(iRow, 1))
Sheets("UrkGrundkurs").Image1.Picture = LoadPicture()
Range("UrkGrundkurs!NameB") = wks.Cells(iRow, 2) & " " & wks.Cells(iRow, 1)
Range("UrkGrundkurs!HundB") = wks.Cells(iRow, 3)
Range("UrkGrundkurs!VereinB") = "von " & wks.Cells(iRow, 5) & " bis " & wks.Cells(iRow, 6)
If wks.Cells(iRow, 7).Value = "W" Then
Range("UrkGrundkurs!PunkteB") = "Der Hundeführerin"
Else: Range("UrkGrundkurs!PunkteB") = "Dem Hundeführer"
End If
Sheets("UrkGrundkurs").Image1.Picture = LoadPicture("c:\UrkundenManager\Bilder\" & wks.Cells(iRow, 4))
Range("UrkGrundkurs!DatumB") = "Schwaig" & ", den " & Date
Sheets("UrkGrundkurs").PageSetup.PrintQuality = 600
Sheets("UrkGrundkurs").PrintOut Copies:=1
iRow = iRow + 1
Loop
Application.ScreenUpdating = True
End Sub

Vielleicht kann der eine oder andere damit was anfangen
Viele Grüße
Peter S.
Anzeige

178 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige