Merhaba,
Aşağıdaki kodda revizyona ihtiyacım var,
SEBEP: normalde çalışması gereken şartlarda aksaklık meydana geliyor.
Hata kodu şu:
Bunu internetten araştırdım ancak bendeki sorunu anlatan birisine denk gelemedim,
Olay kısaca şöyle;
1. Bu kod ile bir listboxdan seçtiğim birden çok çalışma sayfasını PDF olarak kaydedebiliyorum,
2. Dosya adını A1:E2 aralığında bulunan ve formülünde "UPPER" ifadesi olan hücrenin değeri olarak belirliyor.
ANCAK; bazı çalışma sayfalarında yukarıdaki hata kodunu veriyor.
Hata verdiği sayfayı tek olarak seçersem problem yok, PDF olarak kaydediyor,
Hata vermeyen birkaç sayfayı seçersem, hepsini problemsiz olarak PDF dosyaları olarak kaydediyor.
Sıkıntı sadece Hata veren sayfayı diğerleriyle beraber seçtiğimde oluyor.
Bu kodu nasıl revize edebiliriz veya basitleştirebiliriz.
Kod aşağıdadır ve arıza çıkaran kısım ise koyu olarak işaretlenmiştir.
Aşağıdaki kodda revizyona ihtiyacım var,
SEBEP: normalde çalışması gereken şartlarda aksaklık meydana geliyor.
Hata kodu şu:
Kod:
run-time error '-2147024773 (8007007b)
Olay kısaca şöyle;
1. Bu kod ile bir listboxdan seçtiğim birden çok çalışma sayfasını PDF olarak kaydedebiliyorum,
2. Dosya adını A1:E2 aralığında bulunan ve formülünde "UPPER" ifadesi olan hücrenin değeri olarak belirliyor.
ANCAK; bazı çalışma sayfalarında yukarıdaki hata kodunu veriyor.
Hata verdiği sayfayı tek olarak seçersem problem yok, PDF olarak kaydediyor,
Hata vermeyen birkaç sayfayı seçersem, hepsini problemsiz olarak PDF dosyaları olarak kaydediyor.
Sıkıntı sadece Hata veren sayfayı diğerleriyle beraber seçtiğimde oluyor.
Bu kodu nasıl revize edebiliriz veya basitleştirebiliriz.
Kod aşağıdadır ve arıza çıkaran kısım ise koyu olarak işaretlenmiştir.
Kod:
Private Sub CheckBox1_Click()
Dim liste As Integer
For liste = 1 To ListBox1.ListCount
ListBox1.Selected(liste - 1) = CheckBox1.Value
Next
End Sub
Private Sub CommandButton1_Click()
Dim liste As Integer
For liste = 1 To ListBox1.ListCount
If ListBox1.Selected(liste - 1) = True Then
Sheets(ListBox1.List(liste - 1, 0)).PrintOut
ListBox1.Selected(liste - 1) = False
End If
Next
End Sub
[B]Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim liste As Integer
For liste = 1 To ListBox1.ListCount
If ListBox1.Selected(liste - 1) = True Then
For Each alan In Sheets(ListBox1.List(liste - 1, 0)).Range("A1:Z3")
If alan.Formula Like "*" & "UPPER" & "*" Then
adres = alan.Address
Exit For
End If
Next
End If
Next
If adres = "" Then
MsgBox "Yanlış Sayfa Seçtiniz", vbCritical
Exit Sub
End If
Yol = ActiveWorkbook.Path & Application.PathSeparator
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) = True Then
Sheets(ListBox1.List(X)).Copy
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Yol & Range(adres) & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveWindow.Close 0
End If
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub[/B]Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = fmMultiSelectExtended
For i = ActiveWorkbook.Sheets.Count To 1 Step -1
ListBox1.AddItem Sheets(i).Name
Next i
End Sub
Son düzenleme: