- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- gban: Ingyen kellene, de tegnapra
- pr1mzejEE: Viszlát CoD2, CoD4, CS:GO!
- Magga: PLEX: multimédia az egész lakásban
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- eBay-es kütyük kis pénzért
- bitpork: Phautós tali a Balcsinál 2025 Augusztus 2 napján (szombat)
- Brogyi: CTEK akkumulátor töltő és másolatai
Hirdetés
Talpon vagyunk, köszönjük a sok biztatást! Ha segíteni szeretnél, boldogan ajánljuk Előfizetéseinket!
Új hozzászólás Aktív témák
-
Amiens
tag
válasz
sztanozs #2719 üzenetére
Parancsoljatok!
Sub level()
sor = 2
kinek = Sheets("Alap").Range("b6")
Set OutApp = CreateObject("Outlook.Application")
While Not IsEmpty(Sheets(kinek).Cells(sor, 2))
If Sheets(kinek).Cells(sor, 1) = "Igen" And IsEmpty(Sheets(kinek).Cells(sor, 6)) Then
keres = Sheets(kinek).Cells(sor, 2)
Set OutMail = OutApp.CreateItem(0)
With OutMail
If Sheets("Alap").Range("b8") = "Nem" Then
.To = Sheets(kinek).Cells(sor, 3)
Else
.To = "valaki@valami.hu"
End If
If Sheets("Alap").Range("b7") = "Igen" Then
.CC = Sheets(kinek).Cells(sor, 4)
End If
.Subject = Sheets("Alap").Range("b1") & "-" & Sheets(kinek).Cells(sor, 2)
.HTMLBody = ""
.HTMLBody = .HTMLBody & Replace(Sheets("Alap").Range("b2"), Chr(10), "<br>") & "<BR>"
.HTMLBody = .HTMLBody & Replace(Sheets(kinek).Cells(sor, 5), Chr(10), "<br>") & "<BR>"
.HTMLBody = .HTMLBody & Replace(Sheets("Alap").Range("b3"), Chr(10), "<br>") & "<BR>"
If Not IsEmpty(Sheets("Alap").Range("b4")) Then
wb1 = ActiveWorkbook.Name
Workbooks.Open (Workbooks(wb1).Sheets("Alap").Range("b4"))
wb2 = ActiveWorkbook.Name
s = 1
kuld = False
While Not IsEmpty(Workbooks(wb1).Sheets("Alap").Cells(s + 9, 1))
sh = Workbooks(wb1).Sheets("Alap").Cells(s + 9, 1)
Select Case Workbooks(wb1).Sheets("Alap").Cells(s + 9, 3)
Case "Nem kell"
Workbooks(wb2).Sheets(sh).Select
Application.DisplayAlerts = False
Workbooks(wb2).Sheets(sh).Delete
Application.DisplayAlerts = True
Case "Mind"
Case "Szűrő"
oszlop = Workbooks(wb1).Sheets("Alap").Cells(s + 9, 2)
Workbooks(wb2).Sheets(sh).Select
msor = Workbooks(wb1).Sheets("Alap").Cells(s + 9, 4)
msor = msor & ":" & msor
Rows(msor).Select
Selection.AutoFilter
ActiveSheet.Range("$A:$XB").AutoFilter Field:=oszlop, Criteria1:="<>" & keres
Range(Cells(Workbooks(wb1).Sheets("Alap").Cells(s + 9, 4) + 1, 1), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
[A1].Select '.pdf miatt
ActiveSheet.PageSetup.Orientation = xlLandscape '.pdf miatt
ActiveSheet.PageSetup.FitToPagesWide = 1 '.pdf miatt
ActiveSheet.ShowAllData
End Select
s = s + 1
Wend
Filename = ActiveWorkbook.Path & "/" & Workbooks(wb1).Sheets("Alap").Range("B5")
Application.DisplayAlerts = False
If Workbooks(wb1).Sheets("Alap").Range("D5") = ".pdf" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
ActiveWorkbook.SaveAs Filename
End If
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
Set myAttachments = OutMail.Attachments
myAttachments.Add Filename
End If
.Attachments.Add Sheets("Alap").Range("C7")
.Send 'or use .Display
Sheets(kinek).Cells(sor, 6) = Time()
End With
End If
sor = sor + 1
Wend
End Sub
Új hozzászólás Aktív témák
- Battlefield 1
- Redmi Note 10S - egy a sok közül
- Milyen légkondit a lakásba?
- EAFC 25
- Kávé kezdőknek - amatőr koffeinisták anonim klubja
- Steam, GOG, Epic Store, Humble Store, Xbox PC Game Pass, Origin Access, uPlay+, Apple Arcade felhasználók barátságos izgulós topikja
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- Vicces képek
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- További aktív témák...
- DELL Precision 5560 i7-11850H 16GB 512GB T1200 FHD+ 1 év garancia
- LG 27GR95QE - 27" OLED / QHD 2K / 240Hz & 0.03ms / NVIDIA G-Sync / FreeSync Premium / HDMI 2.1
- AKCIÓ! Gigabyte Z370M i5 9400F 16GB DDR4 512GB SSD RX 5700XT 8GB ZALMAN S2 TG Corsair S650W
- Fujitsu LIFEBOOK E449 i5-8250U 8GB 256GB 14" FHD 1 év garancia
- 12 GB-os DDR5 SODIMM laptop memória - garanciával
Állásajánlatok
Cég: FOTC
Város: Budapest