- Milyen okostelefont vegyek?
- Vivo X200 Pro - a kétszázát!
- Samsung Galaxy Z Fold7 - ezt vártuk, de…
- Samsung Galaxy A52s 5G - jó S-tehetség
- Sony Xperia 1 VII - Látod-e, esteledik
- A Pixel 10 minden színben és oldalról
- Hat év támogatást csomagolt fém házba a OnePlus Nord 4
- Xiaomi Mi 10T Pro - a házon belüli ellenfél
- Samsung Galaxy A54 - türelemjáték
- Samsung Galaxy Watch7 - kötelező kör
Hirdetés
-
Mobilarena
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
-
Fferi50
Topikgazda
válasz
Silious #54580 üzenetére
Szia!
Csak makróval lehet megoldani, mert egy cella nem tartalmazhat képletet és számot is.
Én azt javaslom, hogy ne gombot tegyél a cellába, hanem csak egy plusz ill. mínusz jelet. A cellát akár színezheted is.
A cellára dupla kattintással kiváltod a növelést ill. csökkentést. Ehhez az alábbi makrót kell a munkalap kódlapjára bemásolnod:Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + 1
End If
If Target.Column = 3 Then
Target.Offset(0, -1).Value = Target.Offset(0, -1).Value - 1
End If
Cancel = True
End Sub
Az első oszlop bármelyik cellájába írhatod a + jelet ill. a harmadik oszlopba a - jelet. Mindegyikre működik a makró.
Figyelj rá, hogy hibakezelés és védelem nincs a makróban, tehát megváltoztathatók az értékek (a + és - jel is)!
Nálam így néz ki (az első sorba tettem, de bármelyik sorba teheted, a lényeg az A és C oszlop):
Üdv. -
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
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Filmvilág
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Kormányok / autós szimulátorok topikja
- Mibe tegyem a megtakarításaimat?
- Lakáshitel, lakásvásárlás
- Samsung Galaxy Felhasználók OFF topicja
- Azonnali fotós kérdések órája
- Battlefield 6
- gban: Ingyen kellene, de tegnapra
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- HIBÁTLAN iPhone 13 Pro 128GB Graphite -1 ÉV GARANCIA - Kártyafüggetlen, MS3015
- GYÖNYÖRŰ iPhone 13 mini 128GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3047, 94% Akkumulátor
- Dell 14 Latitude 7420 FHD IPS i7-1185G7 4.8Ghz 16GB 512GB SSD Intel Iris XE Win11 Pro Garancia
- AKCIÓ! Apple Macbook Pro 16" 2019 i9 9980HK 64GB 500GB Radeon Pro 5500M notebook garanciával
- HP EliteBook x360 830 G7 i5-10210U 16GB 256GB 13" FHD Áthajtós érintős 1 év garancia
Állásajánlatok
Cég: FOTC
Város: Budapest