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

• #13511 föccer nagyúr

  Új Válasz 2025-03-12 21:46:27 #13511

  Ú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

  

  föccer

  nagyúr

  Sub JelentesKeszites()
    Dim ws As Worksheet, alapadatok As Worksheet, borito As Worksheet
    Dim rng As Range, cell As Range
    Dim dict As Object, receptDict As Object
    Dim receptSzam As String, receptCount As Object
    Dim lastRow As Long, wsEE As Worksheet
    Dim minValue As Double, maxValue As Double, avgValue As Double
    Dim pdfFileName As String, pdfPath As String
    Dim i As Integer, j As Integer
    Dim valasztottUzem As String
    Dim osszesMinta As Integer
    
    ' Alapadatok munkalap beállítása
    Set alapadatok = ThisWorkbook.Sheets("Alapadatok")
    Set borito = ThisWorkbook.Sheets("Borító")
    lastRow = alapadatok.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Egyedi üzemek összegyűjtése
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 2 To lastRow
        If Not dict.exists(alapadatok.Cells(i, 1).Value) Then
            dict.Add alapadatok.Cells(i, 1).Value, Nothing
        End If
    Next i
    
    ' Üzemek listája ellenőrzése
    If dict.Count = 0 Then
        MsgBox "Nincs elérhető üzem az adatokban!", vbExclamation
        Exit Sub
    End If
    
    ' UserForm megjelenítése az üzem kiválasztásához
    valasztottUzem = UzemValasztasForm.ShowForm(dict.keys)
    If valasztottUzem = "" Then Exit Sub
    
    ' Megerősítő kérdés
    If MsgBox("Indulhat a jelentés generálása?", vbYesNo + vbQuestion) <> vbYes Then Exit Sub
    
    ' Receptszámok összegyűjtése és számlálása
    Set receptDict = CreateObject("Scripting.Dictionary")
    Set receptCount = CreateObject("Scripting.Dictionary")
    osszesMinta = 0
    
    For i = 2 To lastRow
        If alapadatok.Cells(i, 1).Value = valasztottUzem Then
            receptSzam = alapadatok.Cells(i, 2).Value
            osszesMinta = osszesMinta + 1
            If Not receptDict.exists(receptSzam) Then
                receptDict.Add receptSzam, Nothing
                receptCount.Add receptSzam, 1
            Else
                receptCount(receptSzam) = receptCount(receptSzam) + 1
            End If
        End If
    Next i
    
    ' Receptek sorrendbe állítása darabszám szerint
    Dim sortedRecepts As Variant
    sortedRecepts = receptCount.keys
    For i = LBound(sortedRecepts) To UBound(sortedRecepts) - 1
        For j = i + 1 To UBound(sortedRecepts)
            If receptCount(sortedRecepts(j)) > receptCount(sortedRecepts(i)) Then
                Dim temp As String
                temp = sortedRecepts(i)
                sortedRecepts(i) = sortedRecepts(j)
                sortedRecepts(j) = temp
            End If
        Next j
    Next i
    
    ' EE munkalapokra másolás
    For i = 0 To Application.Min(UBound(sortedRecepts), 19)
        If receptCount(sortedRecepts(i)) >= 3 Then
            Set wsEE = ThisWorkbook.Sheets("EE_" & (i + 1))
            wsEE.Visible = xlSheetVisible
            ' Adatok másolása EE munkalapokra
            Dim rowIndex As Integer
            rowIndex = 12
            For j = 2 To lastRow
                If alapadatok.Cells(j, 1).Value = valasztottUzem And alapadatok.Cells(j, 2).Value = sortedRecepts(i) Then
                    wsEE.Cells(rowIndex, 1).Resize(, 4).Value = alapadatok.Cells(j, 1).Resize(, 4).Value
                    rowIndex = rowIndex + 1
                End If
            Next j
        End If
    Next i
    
    ' Borító munkalap kitöltése
    borito.Cells(1, 1).Value = "Dátum:"
    borito.Cells(1, 2).Value = Now
    borito.Cells(2, 1).Value = "Üzem:"
    borito.Cells(2, 2).Value = valasztottUzem
    borito.Cells(3, 1).Value = "Minták száma:"
    borito.Cells(3, 2).Value = osszesMinta
    borito.Cells(8, 1).Value = "Receptszám"
    borito.Cells(8, 2).Value = "Minták száma"
    borito.Cells(8, 3).Value = "Minimum"
    borito.Cells(8, 4).Value = "Maximum"
    borito.Cells(8, 5).Value = "Átlag"
    
    ' PDF exportálás kizárólag a szükséges munkalapokkal
    pdfFileName = Format(Now, "yyyymmdd") & "_" & valasztottUzem & ".pdf"
    pdfPath = ThisWorkbook.Path & "\" & pdfFileName
    
    Dim sheetsToExport As Variant
    sheetsToExport = Array("Borító")
    For i = 1 To 20
        On Error Resume Next
        If ThisWorkbook.Sheets("EE_" & i).Visible = xlSheetVisible Then
            ReDim Preserve sheetsToExport(UBound(sheetsToExport) + 1)
            sheetsToExport(UBound(sheetsToExport)) = "EE_" & i
        End If
        On Error GoTo 0
    Next i
    
    ThisWorkbook.Sheets(sheetsToExport).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, OpenAfterPublish:=True
    
    MsgBox "A jelentés elkészült és mentve lett PDF-ben!", vbInformation
    
    End Sub

• #13485 föccer nagyúr

  Új Válasz 2024-12-22 13:46:59 #13485

  Ú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

  

  föccer

  nagyúr

  

• #13270 föccer nagyúr

  Új Válasz 2023-11-09 12:39:41 #13270

  Ú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

  

  föccer

  nagyúr

  

  jujj de jó, megy a közvetlen beillesztés

• #11276 föccer nagyúr

  Új Válasz 2018-03-12 19:24:38 #11276

  Ú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

  

  föccer

  nagyúr

  .

• #8175 föccer nagyúr

  Új Válasz 2013-10-14 22:19:41 #8175

  Ú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

  

  föccer

  nagyúr

  Hosszú_szavak_vagy_kifejezések_tördelése_nem_lehetséges_de_esetleg_be_lehetne_vezetni_azt_amit_a_RIOS5_is_csinál_ilyenkor.

  üdv, föccer

• #7319 föccer nagyúr bagyusz #7318

  Új Válasz 2012-12-26 18:25:08 #7319

  Ú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

  

  föccer

  nagyúr

  válasz bagyusz #7318 üzenetére

  [B]

  

  üdv, föccer

  ps: látom összejött

  üdv, föccer

• #7316 föccer nagyúr

  Új Válasz 2012-12-26 18:11:19 #7316

  Ú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

  

  föccer

  nagyúr

  [B]

  üdv, föccer

• #6449 föccer nagyúr

  Új Válasz 2012-03-19 22:06:53 #6449

  Ú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

  

  föccer

  nagyúr

  Billentyűzet a monitoron.

  lol, ez hatalmas, most már teljesen el lehet tespedni péházás közben.

  üdv, föccet

• #5486 föccer nagyúr

  Új Válasz 2011-07-04 00:41:27 #5486

  Ú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

  

  föccer

  nagyúr

  db ár összes
  Intel S5520SCR alaplap 1 113326 113326
  i7 990x 2 211650 423300
  CMP8GX3M2A1600C8
  8GB Corsair DDR3 RAM 6 34190 205140
  Ocz Vertex 3 120GB
  SATA3 2.5" SSD 3 60850 182550
  Enermax Revolution 85+
  1250W Tápegység 1 99900 99900

  üdv, föccer

• #5467 föccer nagyúr Gabo0905 #5465

  Új Válasz 2011-06-30 17:00:35 #5467

  Ú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

  

  föccer

  nagyúr

  válasz Gabo0905 #5465 üzenetére

  amit tiltunk fórumunkban: ...

  ...
  ◦a mértéktelen és értelmetlen hangulatjel használatot. A smiley-k arra valók, hogy egy többféleképpen értelmezhető mondat hangulatát megmutassák, nem pedig sormintának, díszítőelemnek.

  Forrás:

  

  üdv, föccer

• #5372 föccer nagyúr

  Új Válasz 2011-06-18 23:07:36 #5372

  Ú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

  

  föccer

  nagyúr

  ¯\_(ツ)_/¯

  üdv, föccer

• #5252 föccer nagyúr

  Új Válasz 2011-05-03 19:59:26 #5252

  Ú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

  

  föccer

  nagyúr

  [link]

  Megjelenített szöveg.

  Az okításnak vége

  üdv, föccer

• #5079 föccer nagyúr Racze #5075

  Új Válasz 2011-02-18 16:29:22 #5079

  Ú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

  

  föccer

  nagyúr

  válasz Racze #5075 üzenetére

  

  üdv, föccer

  mod:

  [L:http://prohardver.hu/index.html][IMG:http://logout.hu/dl/upc/2011-02/18/22439_ts1dq5kmuqa5tzcf_prohardver_logo_123.png][/IMG][/L]

  na tessék, addig szöszöltem, amíg megelőztek

  üdv, föccer

• #4468 föccer nagyúr

  Új Válasz 2010-07-01 22:17:29 #4468

  Ú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

  

  föccer

  nagyúr

  No, most jól megnézzük, hogy lehet-e gif-et beszúrnia hozzászólásba...

  Es lőn működik...

  Üdv, föccer

• #1369 föccer nagyúr Pompi #1365

  Új Válasz 2007-09-27 15:54:57 #1369

  Ú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

  

  föccer

  nagyúr

  válasz Pompi #1365 üzenetére

  Nagykirály, hogy eltünk a szerkeztve felirat a sdzerkeztett hzs-ek végéről...

  Köszben próbáltam, csak kiszerkeztettem

• #1362 föccer nagyúr

  Új Válasz 2007-09-27 13:23:31 #1362

  Ú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

  

  föccer

  nagyúr

  no comment

• #1226 föccer nagyúr BlacKSouL #1221

  Új Válasz 2007-09-18 13:02:12 #1226

  Ú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

  

  föccer

  nagyúr

  válasz BlacKSouL #1221 üzenetére

  Ez jó:
  
  
  ╔╗╔═╦╗
  ║╚╣║║╚╗
  ╚═╩═╩═╝
  
  pont 3 sor

• #1156 föccer nagyúr Winner_hun #1150

  Új Válasz 2007-05-24 12:09:09 #1156

  Ú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

  

  föccer

  nagyúr

  válasz Winner_hun #1150 üzenetére

  Erre gondoltok? Vladi is ígyhasználja:
  
  
  Bővebben: [link]

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