UserForm ListBox'ı Print Macro

cocoa35

Altın Üye
Katılım
6 Eylül 2007
Mesajlar
522
Excel Vers. ve Dili
excel 2016 32 Bit ve Excel 2020 32 Bit Türkçe ve İngilizce
Merhaba, Ekli makro ile UserForm'daki ListBox'ı kitap içinde otomatik " YeniSayfa" adında sayfa açıp oraya kopyalayıp sonra yazıcıdan çıktı alınıyor, buraya kadar tamam ancak yazdırma işlemi bitince ekstra Sayfa1 adında başka bir sayfa daha oluşturuyor! bunu nasıl önlerim

Private Sub CommandButton3_Click()
Dim i As Long, a As Integer
On Local Error Resume Next
Sheets.Add.Name = "YeniSayfa"
If Err.Number = 1004 Then MsgBox "Bilgi : " & cvlf & "Sayfa zaten mevcut. ", vbInformation, ""
For i = 0 To ListBox5.ListCount - 1
For a = 0 To ListBox5.ColumnCount - 1
With Sheets("YeniSayfa")
.Cells(i + 2, a + 1).Value = ListBox5.List(i, a)
End With
Next a, i
i = Empty: a = Empty
MsgBox "Seçtiğiniz veriler aktarılmıştır.", vbInformation, ""
Me.Hide
Sheets("yenisayfa").PrintPreview
End Sub
 

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,466
Excel Vers. ve Dili
Office 2016 Türkçe
Merhaba

Birde şu şekilde deneyiniz.

Sub Düğme1_Tıkla()
'25.01.2023 16:47
Dim i As Long, a As Integer
On Local Error Resume Next
For i = 1 To Sheets.Count
If Sheets(i).Name = "YeniSayfa" Then GoTo atla1
Next
Sheets.Add.Name = "YeniSayfa"
atla1:
'If Err.Number = 1004 Then MsgBox "Bilgi : " & cvlf & "Sayfa zaten mevcut. ", vbInformation, ""
For i = 0 To ListBox5.ListCount - 1
For a = 0 To ListBox5.ColumnCount - 1
With Sheets("YeniSayfa")
.Cells(i + 2, a + 1).Value = ListBox5.List(i, a)
End With
Next a, i
i = Empty: a = Empty
MsgBox "Seçtiğiniz veriler aktarılmıştır.", vbInformation, ""
Me.Hide
Sheets("yenisayfa").PrintPreview

End Sub
 

cocoa35

Altın Üye
Katılım
6 Eylül 2007
Mesajlar
522
Excel Vers. ve Dili
excel 2016 32 Bit ve Excel 2020 32 Bit Türkçe ve İngilizce
Merhaba

Birde şu şekilde deneyiniz.

Sub Düğme1_Tıkla()
'25.01.2023 16:47
Dim i As Long, a As Integer
On Local Error Resume Next
For i = 1 To Sheets.Count
If Sheets(i).Name = "YeniSayfa" Then GoTo atla1
Next
Sheets.Add.Name = "YeniSayfa"
atla1:
'If Err.Number = 1004 Then MsgBox "Bilgi : " & cvlf & "Sayfa zaten mevcut. ", vbInformation, ""
For i = 0 To ListBox5.ListCount - 1
For a = 0 To ListBox5.ColumnCount - 1
With Sheets("YeniSayfa")
.Cells(i + 2, a + 1).Value = ListBox5.List(i, a)
End With
Next a, i
i = Empty: a = Empty
MsgBox "Seçtiğiniz veriler aktarılmıştır.", vbInformation, ""
Me.Hide
Sheets("yenisayfa").PrintPreview

End Sub
Kulomer46 Çok teşekkürler oldu :)
 
Üst