Ini hanya buat 1 command Mas, ada sekitar 23 command. Ini untuk Private Sub cmdL_Click() yang digunakan/diganti-ganti: sKet = "Berbentuk seperti rambut ikal. Pada tangan %s memiliki arus alur ke%s." sfile1 = "C:\Tipe Jari\%sL1.jpg" sfile2 = "C:\Tipe Jari\%sL2.jpg"If LenB(lblFolder.Caption) <> 0 Then lblNamaJari.Caption = "Loop" sJari = lblJari.Caption lNo = CLng(Mid$(sJari, 2, 1)) - 1 If Left$(sJari, 1) = "R" Then lSisi = 1 sSisi = Left$(sJari, 1) sSisiTeks = "kanan" Else lSisi = 0 sSisi = vbNullString sSisiTeks = "kiri" End If 'pada bagian diatasga tau kode mana yang mengatakan bahwa lblL1 - lblL5 dan lblR1 - lblR5 memiliki nilai "L"
Misal command ke-dua Private Sub cmdRL_Click(), ini kebalikan dari cmdL, maka bagian yang diganti menjadi: sKet = "Berbentuk kruwel-kruwel atau gimana. Pada tangan %s memiliki arus alur keKANAN." sfile1 = "C:\Tipe Jari\%sRL1.jpg" sfile2 = "C:\Tipe Jari\%sRL2.jpg" lblNamaJari.Caption = "Radial Loop" lblL1 - lblL5 dan lblR1 - lblR5.Caption= "RL" sKet yg cmdRL ini, keterangannya kebalikan dari cmdL Misal command ke-tiga Private Sub cmdTA_Click(), sKet-nya beda lagi, tidak terpengaruh "kanan" dan "kiri" sKet = "Turunan dari tipe Arch menuju Loop." sfile1 = "C:\Tipe Jari\%sTA1.jpg" sfile2 = "C:\Tipe Jari\%sTA2.jpg" lblNamaJari.Caption = "Tented Arch"lblL1 - lblL5 dan lblR1 - lblR5.Caption = "TA" Masih ada: Private Sub cmdPE_Click() Private Sub cmdPE-R_Click() Private SubcmdPE-DL_Click() dll Trimakasih ________________________________ From: Mr. Kid <[email protected]> To: BeExcel <[email protected]> Sent: Saturday, March 30, 2013 4:02 PM Subject: Re: [belajar-excel] Penyederhanaan kode VBA yg berulang-ulang Andaikan object akan terus digunakan sampai userform ditutup, maka proses set object array bisa dilakukan diawal (saat initialize misalnya). Untuk kebutuhan ini, maka variabel dinaikkan scope-nya dari scope prosedur menjadi scope module. Contoh : Pada userform (lembar code userform) beri deklarasi veriabel seperti baris dibawah ini, sebelum baris deklarasi prosedur pertama yang ada : private oLbl(1,4) as label, oTxt(1,4) as textbox Kemudian, karena ada beberapa variabel yang akan selalu tetap nilainya sepanjang userform masih bekerja, maka diberi deklarasi variabel yang diset konstan. Misal variabel sKet, sFile1, sFile2 Biasanya, beginilah cara penggunaan variabel yang diset konstan nilainya. private const sKet as string = "Berbentuk seperti rambut ikal. Pada tangan %s memiliki arus alur ke%s." private const sFile1 as string = "C:\Tipe Jari\%sL1.jpg" private const sFile2 as string = "C:\Tipe Jari\%sL2.jpg" proses set object dilakukan pada event initialize userform : private sub userform_initialize() Set oLbl(0,0)=lblL1:Set oLbl(0,1)=lblL2:Set oLbl(0,2)=lblL3:Set oLbl(0,3)=lblL4:Set oLbl(0,4)=lblL5 Set oLbl(1,0)=lblR1:Set oLbl(1,1)=lblR2:Set oLbl(1,2)=lblR3:Set oLbl(1,3)=lblR4:Set oLbl(1,4)=lblR5 Set oTxt(0,0)=txtL1:Set oTxt(0,1)=txtL2:Set oTxt(0,2)=txtL3:Set oTxt(0,3)=txtL4:Set oTxt(0,4)=txtL5 Set oTxt(1,0)=txtR1:Set oTxt(1,1)=txtR2:Set oTxt(1,2)=txtR3:Set oTxt(1,3)=txtR4:Set oTxt(1,4)=txtR5 end sub nanti pada event click suatu commandbutton bisa berisi : Dim sJari As String,sSisi As String,sSisiTeks As String Dim lSisi As Long,lNo As Long If LenB(lblFolder.Caption) <> 0 Then lblNamaJari.Caption = "Loop" sJari = lblJari.Caption lNo = CLng(Mid$(sJari, 2, 1)) - 1 If Left$(sJari, 1) = "R" Then lSisi = 1 sSisi = Left$(sJari, 1) sSisiTeks = "kanan" Else lSisi = 0 sSisi = vbNullString sSisiTeks = "kiri" End If lblKeterangan.Caption = Replace$(sKet, "%s", sSisiTeks) imgC1.Picture = LoadPicture(vbNullString) imgC1.Picture = LoadPicture(Replace$(sfile1, "%s", sSisi)) imgC2.Picture = LoadPicture(vbNullString) imgC2.Picture = LoadPicture(Replace$(sfile2, "%s", sSisi)) oLbl(lSisi, lNo).Caption = Left$(sJari, 1) oTxt(lSisi, lNo).SetFocus Else MsgBox ("Tentukan Folder Terlebih Dahulu") End If Wassalam, Kid. 2013/3/30 lapendosol opik <[email protected]> > >Trimakasih banyak Mas Kid, > >Kode aslinya ada 10, L1F - L5F dan R1F - R5F >ImgBoxnya ada 2, imgC1 dan imgC2 >Terdapat juga lblNamaJari, tapi ini sifatnya fix, tidak berubah meskipun >berganti L1F sampai R5F >Tujuan saya biar sederhana, termasuk contoh kasusnya jadi saya sederhanakan. >Berikut solusi dari Mas Kid yg udah disesuaikan data aslinya, kalo ada yg >kurang tepat mohon bersedia mengkoreksi lagi: > > >Dim oLbl(1,4)As Control,oTxt(1,4)As Control 'ganti control dengan >msforms.label atau msforms.textbox jika object ada di worksheet >Dim sJari As String,sSisi As String,sSisiTeks As String >Dim lSisi As Long,lNo As Long > >Set oLbl(0,0)=lblL1:Set oLbl(0,1)=lblL2:Set oLbl(0,2)=lblL3:Set >oLbl(0,3)=lblL4:Set oLbl(0,4)=lblL5 >Set oLbl(1,0)=lblR1:Set oLbl(1,1)=lblR2:Set oLbl(1,2)=lblR3:Set >oLbl(1,3)=lblR4:Set oLbl(1,4)=lblR5 >Set oTxt(0,0)=txtL1:Set oTxt(0,1)=txtL2:Set oTxt(0,2)=txtL3:Set >oTxt(0,3)=txtL4:Set oTxt(0,4)=txtL5 >Set oTxt(1,0)=txtR1:Set oTxt(1,1)=txtR2:Set oTxt(1,2)=txtR3:Set >oTxt(1,3)=txtR4:Set oTxt(1,4)=txtR5 >sKet = "Berbentuk seperti rambut ikal. Pada tangan %s memiliki arus alur ke%s." >sfile1 = "C:\Tipe Jari\%sL1.jpg" >sfile2 = "C:\Tipe Jari\%sL2.jpg" > >If LenB(lblFolder.Caption) <> 0 Then > lblNamaJari.Caption = "Loop" > sJari = lblJari.Caption > lNo = CLng(Mid$(sJari, 2, 1)) - 1 > If Left$(sJari, 1) = "R" Then > lSisi = 1 > sSisi = Left$(sJari, 1) > sSisiTeks = "kanan" > Else > lSisi = 0 > sSisi = vbNullString > sSisiTeks = "kiri" > End If > lblKeterangan.Caption = Replace$(sKet, "%s", sSisiTeks) > imgC1.Picture = LoadPicture(vbNullString) > imgC1.Picture = LoadPicture(Replace$(sfile1, "%s", sSisi)) > imgC2.Picture = LoadPicture(vbNullString) > imgC2.Picture = LoadPicture(Replace$(sfile2, "%s", sSisi)) > oLbl(lSisi, lNo).Caption = Left$(sJari, 1) > oTxt(lSisi, lNo).SetFocus > >Else > MsgBox ("Tentukan Folder Terlebih Dahulu") >End If > > >Wassalam > > > > >________________________________ > From: Mr. Kid <[email protected]> >To: BeExcel <[email protected]> >Sent: Saturday, March 30, 2013 2:07 PM >Subject: Re: [belajar-excel] Penyederhanaan kode VBA yg berulang-ulang > > > > >Coba : > >dim oLbl(1,2) as control,oTxt(1,2) as control 'ganti control dengan >msforms.label atau msforms.textbox jika object ada di worksheet > >dim sKet as string, sFile as string, sJari as string,sSisi as string,sSisiTeks >as string > >dim lSisi as long, lNo as long > > >set olbl(0,0)=lblL1:set olbl(0,1)=lblL2:set olbl(0,2)=lblL3 >set olbl(1,0)=lblr1:set olbl(1,1)=lblr2:set olbl(1,2)=lblr3 >set otxt(0,0)=txtL1:set otxt(0,1)=txtL2:set otxt(0,2)=txtL3 >set otxt(1,0)=txtr1:set otxt(1,1)=txtr2:set otxt(1,2)=txtr3 > >sket="Berbentuk seperti rambut ikal. Pada tangan %s memiliki arus alur ke%s." >sfile="C:\Tipe Jari\%sL1.jpg" > >If lenb(lblFolder.Caption) <>0 Then > > sjari=lblJari.Caption > > lno=clng(mid$(sjari,2,1))-1 > > if left$(sjari,1)="R" then > > lsisi=1 > ssisi=left$(sjari,1) > > ssisiteks="kanan" > > else > > lsisi=0 > > ssisi=vbnullstring > > ssisiteks="kiri" > > endif > lblKeterangan.Caption = replace$(sket,"%s",ssisiteks) > imgC1.Picture = LoadPicture(vbNullString) > imgC1.Picture = LoadPicture(replace$(sfile,"%s",ssisi)) > > olbl(lsisi,lno).caption=left$(sjari,1) > > otxt(lsisi,lno).setfocus > >else > MsgBox ("Tentukan Folder Terlebih Dahulu") > >endif > > > > >Wassalam, >Kid. > > > >2013/3/30 lapendosol opik <[email protected]> > > >> >>Dear master excel >>Saya memiliki kode VBA, dimana isi tiap beberapa baris adalah sama dengan >>lainnya. >>Bagaimana cara menyederhanakan kode VBA tersebut agar lebih simple, berikut >>kode VBAnya: >> >> >>Private Sub cmdL_Click() >>If lblFolder.Caption = "" Then >>MsgBox ("Tentukan Folder Terlebih Dahulu") >>ElseIf lblJari.Caption = "L1F" Then >> lblKeterangan.Caption = "Berbentuk seperti rambut ikal. Pada tangan kiri >>memiliki arus alur kekiri." >> imgC1.Picture = LoadPicture(vbNullString) >> imgC1.Picture = LoadPicture("C:\Tipe Jari\L1.jpg") >> lblL1.Caption = "L" >> txtL1.SetFocus >>ElseIf lblJari.Caption = "L2F" Then >> lblKeterangan.Caption = "Berbentuk seperti rambut ikal. Pada tangan kiri >>memiliki arus alur kekiri." >> imgC1.Picture = LoadPicture(vbNullString) >> imgC1.Picture = LoadPicture("C:\Tipe Jari\L1.jpg") >> lblL2.Caption = "L" >> txtL2.SetFocus >>ElseIf lblJari.Caption = "L3F" Then >> lblKeterangan.Caption = "Berbentuk seperti rambut ikal. Pada tangan kiri >>memiliki arus alur kekiri." >> imgC1.Picture = LoadPicture(vbNullString) >> imgC1.Picture = LoadPicture("C:\Tipe Jari\L1.jpg") >> lblL3.Caption = "L" >> txtL3.SetFocus >> >>ElseIf lblJari.Caption = "R1F" Then >> lblKeterangan.Caption = "Berbentuk seperti rambut ikal. Pada tangan kanan >>memiliki arus alur kekanan." >> imgC1.Picture = LoadPicture(vbNullString) >> imgC1.Picture = LoadPicture("C:\Tipe Jari\RL1.jpg") >> lblR1.Caption = "L" >> txtR1.SetFocus >>ElseIf lblJari.Caption = "R2F" Then >> lblKeterangan.Caption = "Berbentuk seperti rambut ikal. Pada tangan kanan >>memiliki arus alur kekanan." >> imgC1.Picture = LoadPicture(vbNullString) >> imgC1.Picture = LoadPicture("C:\Tipe Jari\RL1.jpg") >> lblR2.Caption = "L" >> txtR2.SetFocus >>ElseIf lblJari.Caption = "R3F" Then >> lblKeterangan.Caption = "Berbentuk seperti rambut ikal. Pada tangan kanan >>memiliki arus alur kekanan." >> imgC1.Picture = LoadPicture(vbNullString) >> imgC1.Picture = LoadPicture("C:\Tipe Jari\RL1.jpg") >> lblR3.Caption = "L" >> txtR3.SetFocus >>End If >>End Sub >> >> >>Yang berwarna ungu adalah bagian yang diulang-ulang untuk tangan kiri, dan yang berwarna hijau adalah bagian yang diulang-ulang untuk tangan kanan. >>Mohon pencerahannya untuk kasus seperti ini >>Sebelumnya saya ucapkan banyak terimakasih >>Wassalam >> > > >
