(11/12/2023, 11:45)feraz yazdı: Bu dosya daha iyi oldu.
Currenregion ile yaptım ve 1 lt ve toplamlt olayları ortadan kalktı.
Kod altta değişen.
Kod:Private Sub btn_PDF_Click()
Dim urunAdikac As Long, i As Long, son As Long, say As Long, bulW_W As Long
Dim syf As Worksheet, wb As Workbook, wbSyf As Worksheet, syfRecete As Worksheet, bulundu As Byte, yol As String
Set syf = ThisWorkbook.Worksheets("SayfaListeleri")
With Me.ListBox1
If .ListCount = 0 Then Exit Sub
ReDim arr(1 To 1)
say = 0: bulundu = 0
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
say = say + 1
ReDim Preserve arr(1 To say)
arr(say) = .List(i)
End If
Next
If say > 0 Then
Set wb = Workbooks.Add
Set wbSyf = wb.Worksheets(1)
wbSyf.Name = "PDF"
Application.ScreenUpdating = False
For i = 1 To say
urunAdikac = AraBul(UrunAdi, ThisWorkbook.Worksheets(arr(i)).Range("B:B"))
If urunAdikac > 0 Then
bulundu = 1
Set syfRecete = ThisWorkbook.Worksheets(arr(i))
bulW_W = AraBul(w_w, ThisWorkbook.Worksheets(arr(i)).Range("D:D"))
If bulW_W > 0 Then
With syfRecete.Range(syfRecete.Cells(urunAdikac, "B"), syfRecete.Cells(bulW_W, "D").CurrentRegion) 'ürün adi alani veww alaninin tamami icin
If i = 1 Then
.Copy wbSyf.Cells(Rows.Count, 1).End(3)(2, 1) '2 tek satir atlama icin
ElseIf i > 1 Then
.Copy wbSyf.Cells(Rows.Count, 1).End(3)(4, 1) '4 üc satir atlama icin
End If
End With
End If
End If
Next
birlestirIcerikler wbSyf
PDF2Sayfa wbSyf
Application.ScreenUpdating = True
wbSyf.Columns.AutoFit
Application.CutCopyMode = False
If bulundu > 0 Then
yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now, "dd-mm-yyyy --- hh_mm_ss")
wbSyf.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True
Set obj = CreateObject("Shell.Application")
If Dir(yol & ".pdf") <> "" Then obj.ShellExecute (yol & ".pdf")
Set obj = Nothing
End If
End If
End With
On Error Resume Next
Application.CutCopyMode = False
Erase arr
wb.Close 0
Set syf = Nothing: Set wbSyf = Nothing: Set wb = Nothing
End Sub
elinize sağlık sayın feraz. çalışma %99 bitti.
son bir şey sormak istiyorum olabilir mi diye.(olmazsa da olur. ama olursa süper olur)
F sütunundan başlayıp eklenen maddelerin toplamlarının altına seçenek düşmesi eklesek ve bu seçenek düğmesi seçili olan maddelerin garanti edilen içerik bölümünde görünmesini sağlamak mümkün olur mu? yani seçim yapılmışsa görünecek, seçim yapılmamışsa görünmeyecek.
bu zamana kadar yaptıklarınız için çok teşekkür ederim. saygılar.
iyi çalışmalar.
