Hirdetés
- Milyen egeret válasszak?
- Nvidia GPU-k jövője - amit tudni vélünk
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Samsung Galaxy Tab S9 Ultra - nagy képernyő mindenre
- Bambu Lab 3D nyomtatók
- Billentyűzet gondom van
- Minden USB-C kábel egyforma? Hát NEM. És ez a baj. – Tech Percek #7
- ThinkPad (NEM IdeaPad)
- NVIDIA® driverek topikja
- Milyen RAM-ot vegyek?
-
PROHARDVER!
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Delila_1
veterán
válasz
Silious #50625 üzenetére
Indítás előtt érdemes kitörölni az eddig bevitt képeket: Ctrl + g-re előjön az Ugrás menü, Irányított, Objektumok. Ez kijelöli az összes képet, Delete.
Modulba tedd az alábbi makrót, ami az összes, A oszlopban szereplő képnév mellé beteszi a képet a C oszlopba..Sub Kepbeszuras()
Dim utvonal As String, kep As String, sor As Long, usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row
utvonal = "D:\Jpg\" ' itt add meg a saját útvonaladat
For sor = 1 To usor
kep = utvonal & Cells(sor, 1) & ".jpg"
Cells(sor, 3).Select
On Error Resume Next
ActiveSheet.Pictures.Insert(kep).Select
Selection.Left = Cells(sor, 3).Left + 5
Selection.Top = Cells(sor, 3).Top + 5
Selection.Width = 40 'a kép szélessége
Selection.Height = 30 'a kép magassága
On Error GoTo 0
Next
End Sub -
Delila_1
veterán
válasz
Silious #50610 üzenetére
A makrót a lapodhoz rendeld a Téma összefoglaló szerint.
Mikor beírsz az A oszlopba egy nevet, a megadott utvonal mappából betölti a kep nevű képet a C oszlop azonos sorába.
A makró megjegyzései sorában módosíthatsz az útvonalon, kiterjesztésen, és a képek méretein.Private Sub Worksheet_Change(ByVal Target As Range)
Dim utvonal As String, kep As String
If Target.Column = 1 Then
utvonal = "D:\Jpg\" ' itt add meg a saját útvonaladat
kep = utvonal & Target.Value & ".jpg" 'ha nem jpg a kiterjesztés, írd át
Range(Target.Address).Offset(0, 2).Select
On Error Resume Next
ActiveSheet.Pictures.Insert(kep).Select
Selection.Left = Target.Value.Offset(0, 2).Left + 5
Selection.Top = Target.Value.Offset(0, 2).Top + 5
Selection.Width = 40 'a kép szélessége
Selection.Height = 30 'a kép magassága
Range(Target.Address).Select
On Error GoTo 0
End If
End Sub -
Delila_1
veterán
válasz
Silious #49380 üzenetére
Rendeld a lapodhoz (lásd Összefoglaló) a lenti makrót:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FN As Picture
Dim KepHelye As String
If Target.Column = 1 Then
KepHelye = "C:\kepek\" & Target & ".jpg"
With Cells(Target.Row, 2)
Set FN = ActiveSheet.Pictures.Insert(KepHelye)
.RowHeight = Rows(Target.Row).Height
FN.Top = .Top + 1
FN.Left = Columns(2).Left + 1
FN.Height = Rows(Target.Row).Height - 5
FN.Height = .Height
FN.Placement = xlMoveAndSize
End With
End If
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Hálózati / IP kamera
- EarFun Tune Pro - a család mindent tudója?
- Fotók, videók mobillal
- Kávé kezdőknek - amatőr koffeinisták anonim klubja
- Telekom mobilszolgáltatások
- Xbox Series X|S
- Politika
- Milyen egeret válasszak?
- Nvidia GPU-k jövője - amit tudni vélünk
- Samsung Galaxy S23 Ultra - non plus ultra
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- 27%-OS ÁFÁS SZÁMLA I Jogtiszta Microsoft digitális és fizikai termékek I DIGITALKEYZ.COM
- Azonnali készpénzes Intel i3 i5 i7 i9 8xxx 9xxx processzor felvásárlás személyesen / csomagküldés
- AZONNALI SZÁLLÍTÁSSAL Eladó Windows 8 / 8.1 Pro
- Xiaomi Redmi 9 32GB, Kártyafüggetlen, 1 Év Garanciával
- REFURBISHED és ÚJ - Lenovo ThinkPad Ultra Docking Station (40AJ)
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
Állásajánlatok
Cég: Liszt Ferenc Zeneművészeti Egyetem
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest