code om bepaalde foto's in excel te droppen vervormt de verhouding van de foto

Status
Niet open voor verdere reacties.
Chris Cools

Chris Cools

Gebruiker
Lid geworden
19 okt 2008
Berichten
152
Hallo,

ik heb een stukje code waarmee ik foto's uit een bepaalde map naast het desbetreffende artikel in een excelfile kan droppen.
Het werkt perfect, alleen 1 jammerlijk verschijnsel, de foto's worden niet waarheidsgetrouw weergegeven, sommigen worden in de breedte uitgerokken, sommige in de lengte.

Weet iemand of het mogelijk is om de code zo aan te passen dat de oorspronkelijke verhoudingen niet gewijzigd worden?

Hieronder de code:
"
Sub Insert_Pict1()
Const Afb_map = "N:\PomaxFotos\FotosResult\150x150\"
myarray = WorksheetFunction.Transpose(Range("A3", Range("A" & Rows.Count).End(xlUp)).Value)
ActiveSheet.Protect False, False, False, False, False
If Not IsArray(myarray) Then Exit Sub
On Error Resume Next
lRow = 3
For lLoop = LBound(myarray) To UBound(myarray)
Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
Cells(1, 2).Left + 1, Cells(lRow, 2).Top + 1, 150, 150)
lRow = lRow + 1
Next lLoop
End Sub
"

alvast bedankt!

mvg,

Chris
 
Je kunt eens beginnen met de code op te maken met de CODE knop; dan ziet hij er uit als code.
 
Hallo Octafish,

bedoel je zo? (nog niet eerder op dit forum gepost, sorry...)

mvg,

Chris

Code: 
Sub Insert_Pict1()
 Const Afb_map = "N:\PomaxFotos\FotosResult\150x150\"
 myarray = WorksheetFunction.Transpose(Range("A3", Range("A" & Rows.Count).End(xlUp)).Value)
 ActiveSheet.Protect False, False, False, False, False
 If Not IsArray(myarray) Then Exit Sub
 On Error Resume Next
 lRow = 3
 For lLoop = LBound(myarray) To UBound(myarray)
 Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
 Cells(1, 2).Left + 1, Cells(lRow, 2).Top + 1, 150, 150)
 lRow = lRow + 1
 Next lLoop
 End Sub
 
Code: 
Sub M_snb()
     Const Afb_map = "N:\PomaxFotos\FotosResult\150x150\"
     sn=activesheet.cells(1).currentregion

     For j= 3 To UBound(sn)
         ActiveSheet.Shapes.AddPicture(Afb_map & sn(j,1) & ".jpg", msoFalse, msoCTrue, Columns(2).Left + 1, Rows(j).Top + 1, 150, 150)
     Next 
 End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan