Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
856to860
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
856to860
856to860
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Foto an Zelle anpassen
27.03.2007 16:34:52
Stefan
hallo Vba Profis
Ich habe das folgende Programm hier aus dem Archiv (vielen Dank - ich glaube Sepp hat es geschrieben vielen dank Sepp ) es fungkioniert auch soweit
Es sucht in Spalte A eine Foto Adresse und fügt das Bild ein.
Leider in zu großer Größe und immer übereinander.
Gibt es eine Möglichkeit das Foto auch in die Zelle neben der AdressZelle (zB A2) an Zellgrösse b2 einzufügen
gibt es hierzug eine Lösung ?
vielen Dank im voraus
Stefan
Dim rng As Range
Dim lngR As Long
Dim i As Integer
Dim wks As Worksheet
Set wks = ActiveSheet
On Error Resume Next
Application.ScreenUpdating = False
If blnChk = False Then
lngR = wks.Range("A65536").End(xlUp).Row
blnChk = True
For Each rng In wks.Range("A2:A" & lngR)
If rng "" And rng.Rows.Hidden = False Then
rng.Select
wks.Pictures.Insert(rng.Value).Name = "Bild_" & intC
rng.RowHeight = wks.Pictures("Bild_" & intC).Height
intC = intC + 1
End If
Next
Else
For i = 0 To intC - 1
wks.Pictures("Bild_" & i).Delete
Next
wks.Range("A:A").Rows.AutoFit
blnChk = False
intC = 0
End If
Application.ScreenUpdating = True

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Foto an Zelle anpassen
27.03.2007 21:13:00
fcs
Hallo Stefan,
mit folgenden Anpassungen wird das Bild in die Spalte B eingefügt.
Zusätzlich kannst du das geladenen Bild auf eine gewünschte Größe einstellen (hier z.B. 40 pt)
Gruß
Franz
  Dim rng As Range
Dim lngR As Long
Dim i As Integer
Dim wks As Worksheet
Dim Bild As Shape
Set wks = ActiveSheet
On Error Resume Next
Application.ScreenUpdating = False
'  blnChk = True
If blnChk = False Then
lngR = wks.Range("A65536").End(xlUp).Row
blnChk = True
For Each rng In wks.Range("A2:A" & lngR)
If rng  "" And rng.Rows.Hidden = False Then
rng.Offset(0, 1).Select
wks.Pictures.Insert(rng.Value).Name = "Bild_" & intC
Set Bild = wks.Shapes("Bild_" & intC)
rng.RowHeight = 40
Bild.ShapeRange.LockAspectRatio = msoTrue
Bild.Height = rng.RowHeight
intC = intC + 1
End If
Next
Else
For i = 0 To intC - 1
wks.Pictures("Bild_" & i).Delete
Next
wks.Range("A:A").Rows.AutoFit
blnChk = False
intC = 0
End If
Application.ScreenUpdating = True

Anzeige
AW:danke Franz , es funktioniert
28.03.2007 17:48:25
Stefan
super, danke

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige