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
>
>
>
>
>
>
