Pada event partno exit :
- semua vNilai diganti dengan sPart
- sRackByPart = blabla diganti menjadi :
sRackByPart = Replace$(sRackByPart, "," & sPart,vbnullstring) & "," &
sPart
- buka proteksi sheet lebih dulu. Kemudian akhir dengan proteksi sheet.
Cara proteksi diset agar proteksi hanya untuk userinterface saja. Bunyi
proteksi :
sheets("nama sheetnya").protect "passwordnya",userinterfaceonly:=true
Wassalam,
Kid.
2012/12/3 ngademin Thohari <[email protected]>
> **
>
>
> Be-Exceller, mr. kid
>
> Mohon diverifikasi pekerjaan saya, saya coba program tidak berjalan dengan
> semestinya,
>
>
> Option Explicit
>
> Private Sub UserForm_Initialize()
> Dim ctr As Control
> For Each ctr In Me.Controls
> If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
> If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
> Next ctr
> End Sub
>
> Private Sub UserForm_Activate()
> 'CbType.List = Array("Model1", "Model2", "Model3", "Model4",
> "Model5", "Model6", "Model7", "Model8")
> 'CbType.ListIndex = 0
> CbCust.List = Array("PTIEI", "PTITR", "PTFLUI", "PTSKI", "PTLGIT")
> CbCust.ListIndex = 0
> CbOpr.List = Array("Purwati", "Ria", "Evi Hudi", "Sarwinah", "Tiwi",
> "Maurice")
> CbOpr.ListIndex = 0
> Cbqty.List = Array("0")
> Cbqty.ListIndex = 0
> 'Cbloc.List = Array("78P1WP02-R01-", "78P1WP02-R02-",
> "78P1WP02-R03-", "78P1WP02-R04-", "78P1WP02-R05-", "78P1WP02-R06-",
> "78P1WP02-R07", "78P1WP02-R08", "78P1WP02-R09", "78P1WP02-R10",
> "78P1WP02-R11", "78P1WP02-R12", "78P1WP02-R13", "78P1WP02-R14",
> "78P1WP02-R15")
> 'Cbloc.ListIndex = 0
> Cbcons.List = Array("Bali-1", "A14..", "Common")
> 'Cbcons.ListIndex = 0
>
> 'CbDate = Format(Now, "dd/mm/yyyy hh:mm:ss")
> End Sub
> Private Sub Cbqty_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal
> Shift As Integer)
> Select Case KeyCode
> Case 8, 48 To 57 'tombol back atau tombol angka dari 0 sampai 9
> Case Else 'lainnya
> KeyCode = 0 'gak ada yang dipencet
>
> 'pesan : (udah gak jaman lagi ngrusuhi user yang lagi fokus ngisi
> dengan munculnya msgbox)
> Beep 'sound dikit, daripada keluar msgbox yang
> mengganggu user
> End Select
> End Sub
> Private Sub CmdInput_Click()
> Dim LastRow As Range, Respons
> Dim ctrl As Control
> Sheet3.Unprotect "Belajar-Excel"
> On Error Resume Next
> Set LastRow = Sheet3.Range("C10000").End(xlUp)
> For Each ctrl In Me.Controls
> If TypeName(ctrl) = "TextBox" Then
> If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
> MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input
> Control"
> Exit Sub
> End If
> End If
> Next ctrl
> 'pengolah data partno
> Dim vNilai As Variant
>
> vNilai = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString))
> 'hapus teks '3N1'
> vNilai = Left$(vNilai, InStr(vNilai & " ", " ") - 1) 'ambil kode saja
> (asumsi ada spasi pemisah kode dengan qty)
>
> 'buat jaga-jaga, siapa tahu Excel gak mau auto convert tipedata saat
> ditulisi di bagian with di bawah sana
> If IsNumeric(vNilai) Then 'cek isinya bisa jadi bilangan
> vNilai = CLng(vNilai) 'konversi tipe data
> End If
>
> With LastRow
> .Cells(2, 1) = Tbloc.Value
> .Cells(2, 11) = Tbloc.Value
> .Cells(2, 2) = Cbcons
> .Cells(2, 3) = CbCust
> '.Cells(2, 4) = CbDate
> .Cells(2, 5).Value = vNilai
> .Cells(2, 6) = TbLot.Value
> .Cells(2, 7) = TbPartname.Value
> .Cells(2, 8) = Cbqty.Value
> .Cells(2, 9) = CbOpr
> End With
> Sheet3.Range("A1").Select
> Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4,
> "Material Input Success")
> If Respons = vbNo Then Unload Me
>
> For Each ctrl In Me.Controls
> If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
> Next ctrl
>
> Sheet3.Protect "Belajar-Excel"
> 'set sortcolumns -> siapa tahu pernah dipakai sort rows
> Sheet3.Range("c1").CurrentRegion.Sort
> Sheet3.Range ("g1"), xlAscending, Header:=xlYes, Orientation:=xlSortColumns
>
> End Sub
>
> Private Sub TbPartno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
> Dim rngData As Range, rng As Range
> Dim sPart As String, sRackByPart As String
>
> 'simpan part tanpa 3n1 dan qty
> sPart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus
> teks '3N1'
> sPart = Left$(vNilai, InStr(sPart & " ", " ") - 1) 'ambil kode saja
> (asumsi ada spasi pemisah kode dengan qty)
>
> 'filter data yang ada berdasar spart
> Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 1).Offset(0, 4)
> With rngData
> .Parent.AutoFilterMode = False
> .AutoFilter 1, sPart
> If .SpecialCells(xlCellTypeVisible).Count > 1 Then
> For Each rng In .Offset(1).SpecialCells(xlCellTypeVisible)
> If LenB(rng.Value) <> 0 Then
> sRackByPart = Replace$(sRackByPart, "," & sPart) & "," &
> sPart
> End If
> Next rng
> sRackByPart = Mid$(sRackByPart, 2)
> End If
>
> If LenB(sRackByPart) <> 0 Then
> TextBox1.Text = sRackByPart
> Else
> TextBox1.Text = "Tidak ada rack yang dipakai part " & sPart
> End If
> TextBox1.Locked = True
> .Parent.AutoFilterMode = False
> End With
> End Sub
> Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoolean)
> Dim rngData As Range
> Dim sPart As String, sRack As String
>
> 'simpan part tanpa 3n1 dan qty
> sPart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus
> teks '3N1'
> sPart = Left$(vNilai, InStr(sPart & " ", " ") - 1) 'ambil kode saja
> (asumsi ada spasi pemisah kode dengan qty)
> sRack = Trim$(Tbloc.Text)
>
> 'filter data yang ada berdasar spart
> Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 7).Offset(0, 4)
> With rngData
> .Parent.AutoFilterMode = False
> .Font.Bold = False
> .AutoFilter 1, sPart
> .AutoFilter 7, sRack
> If .Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
> .SpecialCells(xlCellTypeVisible).Font.Bold
> TextBox1.Text = "Sudah dipakai part lain"
> Else
> .Parent.AutoFilterMode = False
> End If
> TextBox1.Locked = True
> End With
> End Sub
>
> Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
> If CloseMode = vbFormControlMenu Then Cancel = True
> End Sub
>
> Private Sub CmdCancel_Click()
> Unload Me
> End Sub
>
> terima kasih
>
> Dwi amin
>
>
> ------------------------------
> **
>
