Public Sub Repotnya_ngePrint()
Dim sShtName As String, sSht() As String
Dim sUser As String
Dim vShtName As Variant
Dim rng As Range
sUser = Sheet1.Range("ac17").Value 'get user's value
'set nama sheet yang pasti di print, atau ada peraturan lain, atur aja
sShtName = "Gabung|cover|Ikhtisar|peserta|KARTU_REMID"
If InStr(sUser, "2") <> 0 Then 'cek pilihan _2
If WorksheetFunction.CountIf(Sheet5.Range("d:d"), "<>0") > 0 Then
'data_2 ada angka selain 0
sShtName =
"UR_Valid|UR_Sk|UR_Butir|UR_Serap|UR_Danil|Batang_URI|UR_Reliabilitas|Jawaba
n_UR|Kompetensi_UR|Kisi-kisi_UR|" & sShtName 'daftar
nama-nama sheetnya
Else
sShtName =
"UR_Valid|UR_Sk|UR_Butir|UR_Serap|UR_Danil|Batang_UR|UR_Reliabilitas|Kompete
nsi_UR|Kisi-kisi_UR|" & sShtName 'nama-nama sheet _2
tanpa data_2
End If
End If
If InStr(sUser, "1") <> 0 Then 'cek pilihan _1
If WorksheetFunction.CountIf(Sheet4.Range("d:d"), "<>0") > 0 Then
'data_1 ada angka selain 0
sShtName =
"Jawaban_PJ|PJ_Serap|PJ_Tuntas|PJ_Butir_soal|PJ_Tabulasi|PJ_Valid|PJ_Valid_A
ll|PJ_Reliabel|Kisi-kisi|" & sShtName 'daftar nama-nama sheetnya
Else
sShtName =
"PJ_Serap|PJ_Tuntas|PJ_Butir_soal|PJ_Tabulasi|PJ_Valid|PJ_Valid_All|PJ_Relia
bel|Kisi-kisi|" & sShtName 'nama-nama sheet _1 tanpa data_1
End If
End If
sSht() = Split(sShtName, "|") 'buat
array nama-nama sheet
For Each vShtName In sSht 'loop
setiap nama sheet (bukan setiap sheet)
With Sheets(vShtName) 'di
sheet yang namanya sedang diproses loop
'tentukan area data yang akan diprint berdasar kata 'nilai'
Set rng = .UsedRange.Find("nilai").CurrentRegion
If Not rng Is Nothing Then 'cek ada
atau tidak areanya
.PageSetup.PrintArea = rng.Address 'set
print area
.PrintOut 'kirim
ke printer
End If 'akhit
blok cek keberadaan area data
End With 'selesai
kerja si sheet tersebut
Next vShtName 'nama
sheet berikutnya
End Sub
mohon koreksi pada kesalahan yang masih di blok kuning mr. Kid....
From: [email protected] [mailto:[email protected]]
On Behalf Of Kid Mr.
Sent: 12 Oktober 2012 0:36
To: [email protected]
Subject: Re: [belajar-excel] tanya cara print dg menggunakan tombol bottom
Hai Prazt,
Cara ke-2 berikut bisa dikembangkan untuk membuat cara 1.
>> Pada sebuah module, tuangkan script sebuah prosedur berikut :
Public Sub Repotnya_ngePrint()
Dim sShtName As String, sSht() As String
Dim sUser As String
Dim vShtName As Variant
Dim rng As Range
sUser = Sheet1.Range("s25").Value 'get user's value
'set nama sheet yang pasti di print, atau ada peraturan lain, atur aja
sShtName = "gabung|kembar"
If InStr(sUser, "_2") <> 0 Then 'cek pilihan _2
If WorksheetFunction.CountIf(Sheet3.Range("d:d"), "<>0") > 0 Then
'data_2 ada angka selain 0
sShtName = "data_2|olah_2a|olah_2b|" & sShtName
'daftar nama-nama sheetnya
Else
sShtName = "olah_2a|olah_2b|" & sShtName
'nama-nama sheet _2 tanpa data_2
End If
End If
If InStr(sUser, "_1") <> 0 Then 'cek pilihan _1
If WorksheetFunction.CountIf(Sheet2.Range("d:d"), "<>0") > 0 Then
'data_1 ada angka selain 0
sShtName = "data_1|olah_1a|olah_1b|" & sShtName
'daftar nama-nama sheetnya
Else
sShtName = "olah_1a|olah_1b|" & sShtName
'nama-nama sheet _1 tanpa data_1
End If
End If
sSht() = Split(sShtName, "|") 'buat
array nama-nama sheet
For Each vShtName In sSht 'loop
setiap nama sheet (bukan setiap sheet)
With Sheets(vShtName) 'di
sheet yang namanya sedang diproses loop
'tentukan area data yang akan diprint berdasar kata 'nilai'
Set rng = .UsedRange.Find("nilai").CurrentRegion
If Not rng Is Nothing Then 'cek ada
atau tidak areanya
.PageSetup.PrintArea = rng.Address 'set
print area
.PrintOut 'kirim
ke printer
End If 'akhit
blok cek keberadaan area data
End With 'selesai
kerja si sheet tersebut
Next vShtName 'nama
sheet berikutnya
End Sub
>> Kemudian set si button (bukan bottom ya) agar menjalankan prosedur
tersebut.
Konsep :
Membuat teks berisi daftar nama-nama sheet yang akan diprint, yang
dipisahkan oleh sebuah karakter pemisah (delimiter).
Dari teks inilah akan didapat array nama sheet yang akan di-print.
Wassalam,
Kid.
2012/10/10 Prazt Math <[email protected]>
Dear exceller...
Mohonbantuannya dengan permasalahan yang menyandung langkah saya seperti
pada file terlampir
(permasalahan / pertanyaan ada di file lampiran)
Terimakasih atas segala bantuan beserta ilmunya...
<<image001.jpg>>
<<image002.jpg>>
