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 sKet As String,sfile1 As String,sfile2 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(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
>
