-
Fototrend
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
-
bteebi
veterán
Sziasztok!
Van egy táblázatom, aminek a sorai alapján (1-50-ig) diagramokat generálok. Úgy van megcsinálva, hogy ha egy adott cellában (jelen esetben az A1-ben) lévő számot megváltoztatom, akkor a diagram annak megfelelően dinamikusan változik. Át szeretném másolni az összes diagramot egy másik munkalapra, egymás alá: egy adott sorban az lenne kiírva, hogy hanyadik ábra, alatta pedig a diagram lenne. Word dokumentumba még jobb lenne, de sajnos egyelőre még csak ott tartok, hogy egy másik lapra másolja át. Pontosabban még ott se, mert valamiért nem működik. (Ráadásul nem is "elegáns".)
Sub graphcopy()
Dim i As Integer
For i = 1 To 50
Sheets("Adatok").Range("A1") = i
Sheets("Adatok").ChartObjects("Diagram 1").Activate
ActiveChart.ChartArea.Copy
Sheets("Diagramok").Cells(2 + (i - 1) * 28, 2) = i & ". ábra"
Sheets("Diagramok").Cells(2 + (i - 1) * 28, 2).Font.Bold = True
Sheets("Diagramok").Cells(3 + (i - 1) * 28, 2).Select
ActiveSheet.Paste
Next
End SubAzt írja, hogy "Range osztály Select metódusa hibás". Mi a baj? Nem túl elegáns egyébként a makró; próbáltam úgy is megcsinálni, hogy Sheets("Adatok").ChartObjects("Diagram 1").Copy, de úgyse ment, a makrórögzítős gagyi megoldással (ActiveChart.ChartArea.Copy
és ActiveSheet.Paste) működött, de ha egymás alá akarom tenni a diagramokat, akkor nem megy.
Új hozzászólás Aktív témák
- Beépített hangszórót is kapott az MSI legfrissebb mini PC-je
- One mobilszolgáltatások
- Luck Dragon: Asszociációs játék. :)
- Fejhallgató erősítő és DAC topik
- Apple MacBook
- Kerékpárosok, bringások ide!
- Proxmox VE
- exHWSW - Értünk mindenhez IS
- Milyen CPU léghűtést vegyek?
- Xiaomi 12 - az izmos 12
- További aktív témák...
- 32GB DDR4 3200
- HP Dell, Fujitsu, üzleti kategóriás notebook kiárusítás - frissítve: 01.03
- HIBÁTLAN iPhone 13 128GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS4245, 100% Akksi
- BESZÁMÍTÁS! MSI B650 R7 7800X3D 32GB DDR5 2TB SSD RTX 5070Ti 16GB Asus ROG Strix Helios GX601 750W
- Lenovo Thunderbolt 3 kábel (4X90U90617)
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
