Új hozzászólás Aktív témák

• #43229 sztanozs veterán Alex123 #43218

  Új Válasz 2020-03-11 14:18:41 #43229

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  sztanozs

  veterán

  válasz Alex123 #43218 üzenetére

  Sub Macro1()
'
' Macro1 Macro
'

'
lastrow = 11 'annyira kell módosítani, amelyik az utolsó sor
For r = 2 To lastrow
Range(Cells(1, 1), Cells(r, 4)).Select
Selection.Copy
Cells(lastrow + r * 2, 1).Select
ActiveSheet.Pictures.Paste
Cells(r, 1).EntireRow.Hidden = True
Next
Range(Cells(1, 1), Cells(lastrow, 1)).EntireRow.Hidden = False
End Sub

• #43213 sztanozs veterán Alex123 #43196

  Új Válasz 2020-03-10 10:14:22 #43213

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  sztanozs

  veterán

  válasz Alex123 #43196 üzenetére

  Így piros hullámos aláhúzásokkal?

• #43196 Alex123 senior tag Alex123 #43195

  Új Válasz 2020-03-08 10:54:02 #43196

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Alex123

  senior tag

  válasz Alex123 #43195 üzenetére

  Tehát pl. ilyen az eredeti táblázat:
  
  
  És így kellene kiexportálni belőle képként:
  
  
  
  
  
  
  Várom az ötleteket, köszönöm.

• #43195 Alex123 senior tag Alex123 #43188

  Új Válasz 2020-03-07 09:21:33 #43195

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Alex123

  senior tag

  válasz Alex123 #43188 üzenetére

  "A képek kimentésekor pedig a kép neve a táblázat első két oszlopában (A, B) szereplő soronkénti szöveges rekord tartalma lenne..."
  
  Erre találtam már megoldást:
  Sub SaveImages()

    'the location to save all the images
    Const destFolder$ = "C:\users\...\desktop\"

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("sheet1")

    Dim ppt As Object, ps As Variant, slide As Variant

    Set ppt = CreateObject("PowerPoint.application")
    Set ps = ppt.presentations.Add
    Set slide = ps.slides.Add(1, 1)

    Dim shp As Shape, shpName$
    For Each shp In ws.Shapes
        shpName = destFolder & shp.TopLeftCell.Offset(1, 1) & ".png"
        shp.Copy
        With slide
            .Shapes.Paste
            .Shapes(.Shapes.Count).Export shpName, 2
            .Shapes(.Shapes.Count).Delete
        End With
    Next shp

    With ps
        .Saved = True
        .Close
    End With
    ppt.Quit
    Set ppt = Nothing

End Sub

  Már "csak" ezt a részét kellene megoldani:
  "magát a fejlécet és alatta az első sort jpeg (vagy más) kép formátumban, majd sorban a többi sort is léptetve hasonlóan: a fejlécet és hozzá a második sort, harmadik sort... szintén képként kimenteni és így tovább..."
  
  Van ötletetek?
  

• #38494 Alex123 senior tag Alex123 #38493

  Új Válasz 2018-07-09 14:01:20 #38494

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Alex123

  senior tag

  válasz Alex123 #38493 üzenetére

  Megoldottam!!!

• #38493 Alex123 senior tag Alex123 #38492

  Új Válasz 2018-07-08 15:12:54 #38493

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Alex123

  senior tag

  válasz Alex123 #38492 üzenetére

  Ezzel a kóddal ki tudom menteni a képeket:

  Sub SaveImages()

'the location to save all the images
Const destFolder$ = "C:\users\...\desktop\"

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("sheet1")

Dim ppt As Object, ps As Variant, slide As Variant

Set ppt = CreateObject("PowerPoint.application")
Set ps = ppt.presentations.Add
Set slide = ps.slides.Add(1, 1)

Dim shp As Shape, shpName$
For Each shp In ws.Shapes
shpName = destFolder & shp.TopLeftCell.Offset(1, 1) & ".png"
shp.Copy
With slide
.Shapes.Paste
.Shapes(.Shapes.Count).Export shpName, 2
.Shapes(.Shapes.Count).Delete
End With
Next shp

With ps
.Saved = True
.Close
End With
ppt.Quit
Set ppt = Nothing

End Sub

  A kép nevét át is nevezi a következőképpen (A oszlop 1 sor kép, B oszlop második sor a kép neve).
  Ez így tökéletesen működik is...

  DE:
  - azt hogyan tudom elérni, hogy a képek (az excel táblázatban kicsinyítve vannak) a valós, 100%-os méretükkel kerüljenek kimentésre?

  Várom az ötleteket, köszönöm!

• #38492 Alex123 senior tag Alex123 #38482

  Új Válasz 2018-07-08 14:46:04 #38492

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Alex123

  senior tag

  válasz Alex123 #38482 üzenetére

  Addig eljutottam, hogy már "csak" a képeket kellene kiexportálni a táblázatból valahogyan, mert eddig amit letöltöttem plugint excel alá, az összekeverte a képek sorrendjét!

  Fontos lenne a sorrend, mivel kimentettem hozzá a két szöveges cella egyesítését, azzal pedig már át tudom nevezni a képeket a kívánt elnevezésre.

  Próbáltam web-es kimentést is belőle de az meg 1 képből van, hogy ment kettő, három különböző méretűt is... így megint csak válogatni kellene őket...

  A képek kimentésére van valahol "használható" plugin, kód, stb ?

  (a képek külön-külön sorokban vannak, soronként csak 1db szerepel.)

  Köszönöm ha tud valaki segíteni!

• #3889 Delila_1 veterán Alex123 #3888

  Új Válasz 2008-09-14 18:00:05 #3889

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Alex123 #3888 üzenetére

  Szívesen.

• #3887 Delila_1 veterán Alex123 #3886

  Új Válasz 2008-09-14 13:15:24 #3887

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Alex123 #3886 üzenetére

  A lenti makró elvégzi a munkát.
  Ha biztos vagy benne, hogy az A oszlopban minden cím csak egyszer szerepel, akkor így jó lesz a makró, ha nem biztos, akkor az Exit For sort töröld a futtatás előtt.

  Sub egyezo_torles()
  ucsoA = Range("A65536").End(xlUp).Row
  ucsoB = Range("B65536").End(xlUp).Row
  Cells(1, 3).FormulaR1C1 = "=COUNTIF(C[-2],RC[-1])"
  Range("C1").Select
  Selection.AutoFill Destination:=Range("C1:C" & ucsoB)
  For sorB = 1 To ucsoB
  If Cells(sorB, 2) > 0 Then
  email = Cells(sorB, 2)
  For sorA = 1 To ucsoA
  Cells(sorA, 1).Select
  If Cells(sorA, 1) = email Then
  Selection.Delete Shift:=xlUp
  Exit For
  End If
  Next
  End If
  Next
  Columns("C:C").Select
  Selection.ClearContents
  Range("A1").Select
  End Sub

Új hozzászólás Aktív témák