yazıcıdan çıktı alma kopya sayısını siz belirleyin Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz. 
 
Sub PrintOnePage()
    Dim wshTemp As Worksheet, wsh As Worksheet
    Dim rngArr() As Range, c As Range
    Dim i As Integer
    Dim j As Integer

ReDim rngArr(1 To 1)
    For Each wsh In ActiveWorkbook.Worksheets
        i = i + 1
        If i > 1 Then   ' resize array
            ReDim Preserve rngArr(1 To i)
        End If

On Error Resume Next
        Set c = wsh.Cells.SpecialCells(xlCellTypeLastCell)
        If Err = 0 Then
            On Error GoTo 0

'Prevent empty rows
            Do While Application.CountA(c.EntireRow) = 0 _
              And c.EntireRow.Row > 1
                Set c = c.Offset(-1, 0)
            Loop

Set rngArr(i) = wsh.Range(wsh.Range("A1"), c)
        End If
    Next wsh

'Add temp.Worksheet
    Set wshTemp = Sheets.Add(after:=Worksheets(Worksheets.Count))

On Error Resume Next
    With wshTemp
        For i = 1 To UBound(rngArr)
            If i = 1 Then
                Set c = .Range("A1")
            Else
                Set c = _
                  ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
                Set c = c.Offset(2, 0).End(xlToLeft)  ' skip one row
            End If

'Copy-paste range (prevent empty range)
            If Application.CountA(rngArr(i)) > 0 Then
                rngArr(i).Copy c
            End If
        Next i
    End With
    On Error GoTo 0

Application.CutCopyMode = False ' prevent marquies

With ActiveSheet.PageSetup     ' Fit to 1 page
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

'Preview New Sheet
    ActiveWindow.SelectedSheets.PrintPreview

'Print Desired Number of Copies
    i = InputBox("Print how many copies?", "ExcelTips", 1)
    If IsNumeric(i) Then
        If i > 0 Then
            ActiveSheet.PrintOut Copies:=i
        End If
    End If

'Delete temp.Worksheet?
    If MsgBox("Delete the temporary worksheet?", _
      vbYesNo, "ExcelTips") = vbYes Then
        Application.DisplayAlerts = False
        wshTemp.Delete
        Application.DisplayAlerts = True
    End If
End Sub

Benzer Sonuçlar
No	Makro Adı
1	yazıcıdan çıktı alma kopya sayısını siz belirleyin
2	sayfanın kopyasını alma (adını siz belirleyin)
3	excelde kendi eklenti ve fonksiyonlarınızı oluşturun
4	hücre tanımlayarak yazıcıdan çıktı alma
5	hücredeki sayı kadar yazıcıdan çıktı alma
6	Inputbox'a göre çıktı sayısı 2
7	yüklü yazıcı var mı yok mu
8	VBA ve Pivot Tablosunu Kullanarak Listedeki Her Bir Öğenin Sayısını Bulma
9	listbox ve combobox'a veri girmek
10	tek hücrede yer alan "ad soyad" bilgisini ayrı hücrelere alma
11	önizlemesiz a5 kaüıttan çıktı alma
12	bir kitaptaki sayfalara başka bir kitaba taşımak
13	sayfa kopyasını siz belirleyin
14	llistede kaç kişi olduğunu bulmanın kısayolu.
15	hücrede bir sonraki ayın gün sayısı kadar gün ilave etme
16	hücredeki ad soyadı ayırmak
17	şifreli kapali bir dosyadan veri almak
18	wordpada yazdırmak istediğiniz bir metni excel içerisinden yazdırmak için
19	veri değiştirirken uyarı alma
20	belirlenen hücre aralığının çıktısını almak

Benzer Sonuçlar

Makro Adı

yazıcıdan çıktı alma kopya sayısını siz belirleyin

sayfanın kopyasını alma (adını siz belirleyin)

excelde kendi eklenti ve fonksiyonlarınızı oluşturun

hücre tanımlayarak yazıcıdan çıktı alma

hücredeki sayı kadar yazıcıdan çıktı alma

Inputbox'a göre çıktı sayısı 2

yüklü yazıcı var mı yok mu

VBA ve Pivot Tablosunu Kullanarak Listedeki Her Bir Öğenin Sayısını Bulma

listbox ve combobox'a veri girmek

tek hücrede yer alan "ad soyad" bilgisini ayrı hücrelere alma