Hot Fox: Re: ]] XL-mania [[ print list nama sekaligus

Om om.....ini "JANG SOESAH BUKAN SETING LAYOUTNYA tapi MAKRO UNTUK MENCARI nama PANGGILAN".........................

Kodingannya oom Untuk Mencari Nama Panggilan (Dengan Asumsi....Nama Panggilan = Nama Depan dari NAMA LENGKAP)
' ---------------------------------
' Created By : puthut_vai@yahoo.com
' on 15 Oktober 2009
' Nama Form :FrmPrintoom.frm
' ---------------------------------
' ---------------------------------------------------------
' Fungsi untuk Mencari Nama Panggilan
' ---------------------------------------------------------
Function fCariNMPanggilan(FullName As String) As Variant

Dim vNamaPanggilan As String
Dim vNamaBelakang As String
Dim vNamaTengah As String
Dim vGelar As String
Dim vPnjngHuruf As Integer
Dim vPnjngHuruf2 As Integer
Dim vPnjngHuruf3 As Integer

vPnjngHuruf = InStr(1, FullName, ".", vbTextCompare)
If vPnjngHuruf = 0 Then
    vPnjngHuruf = Len(FullName) + 1
End If
vNamaBelakang = Trim(Left(FullName, vPnjngHuruf - 1))

vPnjngHuruf2 = InStr(1, vNamaBelakang, " ", vbTextCompare)
If vPnjngHuruf2 Then
    vPnjngHuruf3 = InStr(vPnjngHuruf2 + 1, vNamaBelakang, " ", vbTextCompare)
    If vPnjngHuruf3 Then
        vGelar = Right(vNamaBelakang, Len(vNamaBelakang) - vPnjngHuruf3)
        vNamaBelakang = Left(vNamaBelakang, vPnjngHuruf3 - 1)
    Else
        vGelar = Right(vNamaBelakang, Len(vNamaBelakang) - vPnjngHuruf2)
        vNamaBelakang = Left(vNamaBelakang, vPnjngHuruf2 - 1)
    End If
End If

vPnjngHuruf2 = InStr(vPnjngHuruf + 2, FullName, " ", vbTextCompare)
If vPnjngHuruf2 = 0 Then
    vPnjngHuruf2 = Len(FullName)
End If

If vPnjngHuruf2 > vPnjngHuruf Then
    vNamaPanggilan = Mid(FullName, vPnjngHuruf + 1, vPnjngHuruf2 - vPnjngHuruf)
    vNamaTengah = Right(FullName, Len(FullName) - vPnjngHuruf2)
End If
' NGILANGIN NAMA YG MAKE BIN BIN NAN

vPnjngHuruf = InStr(1, vNamaBelakang, "Bin", vbTextCompare)
If vPnjngHuruf Then
    vNamaBelakang = Trim(StrConv(Left(vNamaBelakang, vPnjngHuruf), vbProperCase)) & _
    Trim(StrConv(Right(vNamaBelakang, Len(vNamaBelakang) - vPnjngHuruf), vbProperCase))
Else
    vNamaBelakang = Trim(StrConv(vNamaBelakang, vbProperCase))
End If

vNamaPanggilan = Trim(StrConv(vNamaPanggilan, vbProperCase))
fCariNMPanggilan = Replace(UCase(vNamaBelakang), "BIN", "")

End Function

Sedangkan untuk NGEPLOT DATA Ke Dalam LAYOUT:
- Di Dalam Form :
' ---------------------------------
' Created By : puthut_vai@yahoo.com
' on 15 Oktober 2009
' Nama Form :FrmPrintoom.frm
' ---------------------------------

Option Explicit
Dim wShitMaster As Worksheet
Private Sub CmdCetak_Click()
Dim vNilaiBawah, vNilaiAtas As Integer
' -------------------------------------
' Validasi jumlah 'ROW' yang di cetak......
vNilaiBawah = Cbox1.Value
vNilaiAtas = Cbox2.Value
If vNilaiAtas - vNilaiBawah >= 14 Then
    MsgBox "Maksimum data yang dicetak 12 bijix oom....", vbInformation
    Cbox2.SetFocus
    Exit Sub
Else
    vNilaiBawah = vNilaiBawah + 3
    vNilaiAtas = vNilaiAtas + 3
End If
' -------------------------------------
' Validasi.....nilai batas bawah dan atas dari row..
If vNilaiBawah > vNilaiAtas Then
    MsgBox "Batas bawah kegedeean oom", vbInformation
    Cbox1.SetFocus
    Exit Sub
ElseIf vNilaiBawah = vNilaiAtas Then
    MsgBox "Gak boleh sama oom", vbInformation
    Cbox2.SetFocus
    Exit Sub
Else
    ' Panggil Fungsi Cetak...
    fSetLayout vNilaiBawah, vNilaiAtas
    Unload Me
    ActiveSheet.PrintPreview
End If
End Sub

Private Sub UserForm_Activate()
Dim i As Integer

Set wShitMaster = Worksheets("Sheet1")
i = 4
Do While wShitMaster.Cells(i, 1) <> ""
    With Cbox1
        .AddItem wShitMaster.Cells(i, 1)
    End With
    With Cbox2
        .AddItem wShitMaster.Cells(i, 1)
    End With

i = i + 1
Loop
Cbox1.ListIndex = 0
Cbox2.ListIndex = 0
End Sub

- Di Dalam Modul :
' ---------------------------------
' Created By : puthut_vai@yahoo.com
' on 15 Oktober 2009
' Nama Modul : Momod.mod
' ---------------------------------

Option Explicit

Dim wShitHasilAkhir As Worksheet
Dim x As Variant
Dim r As Long
Dim txtValidasi As Long
Dim vCountSebelahKiri, vCountSebelahKanan As Long
Dim wShitMaster As Worksheet
Dim i As Long

' ---------------------------------------------------------
' Fungsi untuk seting layout kartu pegawai
' ---------------------------------------------------------
Public Function fSetLayout(ByVal sBawah As Long, ByVal sAtas As Long)
Application.ScreenUpdating = False

Set wShitMaster = Worksheets("Sheet1") ' Set Master
Set wShitHasilAkhir = Worksheets("Sheet2") ' Set Layout

wShitMaster.Activate

vCountSebelahKiri = 1
vCountSebelahKanan = 1

r = 4

Do While Cells(r, 1) <> ""
txtValidasi = wShitMaster.Cells(r, 1)
' Masukan Data Ke item
    For i = sBawah To sAtas
        If txtValidasi = wShitMaster.Cells(i, 1) Then
            ' Pembatasan pada jumlah layout yang sampai dengan 6
            If vCountSebelahKiri > 47 Then
                wShitHasilAkhir.Cells(vCountSebelahKanan, 7) = fCariNMPanggilan(wShitMaster.Cells(i, 4))
                wShitHasilAkhir.Cells(vCountSebelahKanan + 2, 7) = wShitMaster.Cells(i, 1)
                wShitHasilAkhir.Cells(vCountSebelahKanan + 3, 7) = wShitMaster.Cells(i, 2)
                wShitHasilAkhir.Cells(vCountSebelahKanan + 4, 7) = wShitMaster.Cells(i, 4)
                vCountSebelahKanan = vCountSebelahKanan + 8
            Else
                wShitHasilAkhir.Cells(vCountSebelahKiri, 3) = fCariNMPanggilan(wShitMaster.Cells(i, 4))
                wShitHasilAkhir.Cells(vCountSebelahKiri + 2, 3) = wShitMaster.Cells(i, 1)
                wShitHasilAkhir.Cells(vCountSebelahKiri + 3, 3) = wShitMaster.Cells(i, 2)
                wShitHasilAkhir.Cells(vCountSebelahKiri + 4, 3) = wShitMaster.Cells(i, 4)
                vCountSebelahKiri = vCountSebelahKiri + 8
            End If

        End If

    Next i
r = r + 1
Loop

Application.ScreenUpdating = True
wShitHasilAkhir.Activate

End Function

File Terlampir oomm.......

- ^ Puthut Wibowo ^ - puthut_vai@yahoo.com

* Clue Untuk Pass VBA nya oomm.....
Dim katasandi as string
katasandi=LCASE(

)

--- On Wed, 10/14/09, Donni <rahm@tdonni.co.cc> wrote:

From: Donni <rahm@tdonni.co.cc>
Subject: ]] XL-mania [[ print list nama sekaligus
To: XL-mania@yahoogroups.com
Date: Wednesday, October 14, 2009, 10:23 PM

Dear All Master,

Mohon pencerahan.. .Berkas terlampir..bagaiman a cara untuk print seperti sheet 2 sekaligus,datanya di ambil dari sheet 1

thanks

__._,_.___

Messages in this topic (3) Reply (via web post) | Start a new topic

Messages

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Moderasi akan lambat minggu ini, momods pergi ke tempat jauh      |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch format to Traditional
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe

__,_._,___

Hot Fox

quinta-feira, 15 de outubro de 2009

Re: ]] XL-mania [[ print list nama sekaligus

Nenhum comentário:

Arquivo do blog