Mohon bantuannya untuk mengatasi hasil VBA yang seperti screen shot di bawah ini dimana hasil dari vbs bisa di geser akan menimbulkan bayangan yang tidak bisa hilang. mohon solusinya.

source code

Option Explicit
Dim CbLock As Boolean, Simpan As Boolean
Dim FormMode As String
Dim harga As Double
Const MsgboxTitle = "Daftar Barang"

'=================================================================================
' CCCCC
'=================================================================================
Private Sub CBTAMBAH_Click()
Dim JmlMasuk, JmlKeluar, JmlSisa
CbLock = True
Unlok
TBKODE.Value = Empty
TBNAMA.Value = Empty
TBSAT.Value = Empty
harga = 0
TBHARGA.Value = 0
OPYES.Value = True
OPNO.Value = False
JmlMasuk = 0
TBMASUK = JmlMasuk
JmlKeluar = 0
TBKELUAR = JmlKeluar
JmlSisa = 0
TBSISA = JmlSisa
FormMode = "Tambah"
End Sub

Private Sub CBBATAL_Click()
FormMode = "Ready"
CbLock = False
Unlok
RefreshControl
End Sub

Private Sub CBEDIT_Click()
CbLock = True
Unlok
FormMode = "Edit"
End Sub

Private Sub CBOK_Click()
Dim LnBrg As Integer
If TBKODE.Value = Empty Then
MsgBox "kode barang masih kosong", vbInformation, MsgboxTitle
Exit Sub
End If
If TBNAMA.Value = Empty Then
MsgBox "nama barang masih kosong", vbInformation, MsgboxTitle
Exit Sub
End If
If FormMode = "Tambah" Then
LnBrg = SBBRG.Max + 1
Else
LnBrg = SBBRG.Value
End If
If Not CheckDup(TBKODE.Value, "A", LnBrg, FormMode) Then GoTo ErrOk
With ThisWorkbook.Sheets("TbBarang")
Application.ScreenUpdating = True
.Unprotect
.Range("A" & LnBrg).Value = TBKODE.Value
.Range("B" & LnBrg).Value = TBNAMA.Value
.Range("C" & LnBrg).Value = TBSAT.Value
.Range("D" & LnBrg).Value = harga
.Range("E" & LnBrg).Value = OPYES.Value
MsgBox FormMode & " data berhasil", vbInformation, MsgboxTitle
Simpan = True
.Protect
Application.ScreenUpdating = False
End With
If FormMode = "Tambah" Then
Sekrol
SBBRG.Value = SBBRG.Max
End If
CBBATAL_Click
Exit Sub
ErrOk:
MsgBox "No ID sudah dipakai", vbCritical, MsgboxTitle
Exit Sub
End Sub

Private Sub Label28_Click()

End Sub

Private Sub Label30_Click()

End Sub

Private Sub SBBRG_Change()
RefreshControl
End Sub

Private Sub TBHARGA_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo ErrHarga
harga = TBHARGA.Value
TBHARGA.Value = FormatNumber(harga, 0, vbTrue, vbTrue, vbTrue)
Exit Sub
ErrHarga:
MsgBox "hANya boLeH bERISi aNGka!", vbOKOnly + vbCritical, MsgboxTitle
harga = 0
TBHARGA = FormatNumber(harga, 0, vbTrue, vbTrue, vbTrue)
End Sub

Private Sub TBHARGA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If IsNumeric(Chr(KeyAscii)) = False And KeyAscii <> vbKeyBack And KeyAscii <> 44 Then
KeyAscii = 0
End If
End Sub

Private Sub TBHARGA_Enter()
TBHARGA.Value = harga
End Sub

Private Sub CBXKOLFILTER_Change()
LBFILTER.RowSource = FilterBarang(TBFILTER.Value, CBXKOLFILTER.ListIndex)
End Sub

Private Sub LBFILTER_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim response As VbMsgBoxResult
If LBFILTER.Value = Null Then Exit Sub
response = MsgBox("tampilkan data " & LBFILTER.Value & " ??", vbYesNo + vbQuestion, MsgboxTitle)
If response = vbNo Then Exit Sub
SBBRG.Value = Application.WorksheetFunction.Match(LBFILTER.Value, ThisWorkbook.Sheets("TbBarang").Range("A:A"), 0)
End Sub

Private Sub TBFILTER_Change()
LBFILTER.RowSource = FilterBarang(TBFILTER.Value, CBXKOLFILTER.ListIndex)
End Sub

Private Sub UserForm_Activate()
Dim text1 As control
Dim i As Integer
Application.Calculation = xlCalculationManual
ThisWorkbook.Activate
Sheets("TbBarang").Select
Application.ScreenUpdating = False
Call Sekrol
CBXKOLFILTER.Clear
For i = 1 To 5
CBXKOLFILTER.AddItem Sheets("TbBarang").Cells(1, i).Value
Next i
CBXKOLFILTER.ListIndex = 1
CbLock = False
Call Unlok
FormMode = "Ready"
Simpan = False
Set text1 = Controls.Add("Forms.Label.1", "TT", True)
text1.Move 12, 360, 420, 12
text1.Caption = AuthorGen2()
If SBBRG.Max = 1 Then
MsgBox "Data masih kosong", vbInformation, MsgboxTitle
Call CBTAMBAH_Click
CBBATAL.Enabled = False
Exit Sub
End If
RefreshControl
End Sub

Private Sub UserForm_Terminate()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ThisWorkbook.Sheets("TbBarang").Range("A" & SBBRG.Value & ":E" & SBBRG.Value).Select
ThisWorkbook.Sheets("TbBarang").Protect
If Simpan Then ThisWorkbook.Save
End Sub

'=================================================================================
' FFFFFFF
'=================================================================================

Private Function CheckDup(w As Variant, x As String, y As Integer, z As String) As Boolean
Dim TempCD1, TempCD2, RgLook
On Error GoTo ErrCheckDup
CheckDup = True
RgLook = x & "1:" & x & SBBRG.Max
TempCD1 = Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("TbBarang").Range(RgLook), w)
If z = "Tambah" Then
If TempCD1 > 0 Then CheckDup = False
ElseIf z = "Edit" Then
If TempCD1 > 1 Then
CheckDup = False
ElseIf TempCD1 = 1 Then
TempCD2 = Application.WorksheetFunction.Match(w, ThisWorkbook.Sheets("TbBarang").Range(RgLook), 0)
If TempCD2 <> y Then CheckDup = False
End If
End If
Exit Function
ErrCheckDup:
MsgBox "ErrCheckDup", vbCritical, MsgboxTitle
CheckDup = False
End Function

'=================================================================================
' PPPPPPP
'=================================================================================

Private Sub Unlok()
CBTAMBAH.Enabled = Not CbLock
CBEDIT.Enabled = Not CbLock
SBBRG.Enabled = Not CbLock
CBOK.Enabled = CbLock
CBBATAL.Enabled = CbLock
TBKODE.Locked = Not CbLock
TBNAMA.Locked = Not CbLock
TBSAT.Locked = Not CbLock
TBHARGA.Locked = Not CbLock
OPYES.Locked = Not CbLock
OPNO.Locked = Not CbLock
End Sub

Private Sub Sekrol()
SBBRG.Max = LastCell(ThisWorkbook.Name , "TbBarang", "A")
If SBBRG.Max <= 1 Then
SBBRG.Min = 1
Else
SBBRG.Min = 2
End If
SBBRG.LargeChange = Round(SBBRG.Max / 5, 0)
End Sub

Private Sub RefreshControl()
Dim JmlMasuk, JmlKeluar, JmlSisa
With ThisWorkbook.Sheets("TbBarang")
TBKODE.Value = .Cells(SBBRG, 1).Value
TBNAMA.Value = .Cells(SBBRG, 2).Value
TBSAT.Value = .Cells(SBBRG, 3).Value
harga = .Cells(SBBRG.Value, 4).Value
TBHARGA.Value = FormatNumber(harga, 2, vbUseDefault, vbUseDefault, vbUseDefault)
OPYES.Value = .Cells(SBBRG, 5).Value
OPNO.Value = Not .Cells(SBBRG, 5).Value
On Error Resume Next
With ThisWorkbook.Sheets("dummy")
.Range("R:AC").Clear
.Cells(1, 20).Value = "Kode Barang"
.Cells(2, 20).Value = TBKODE.Value
.Cells(1, 21).Value = "Jumlah"
ThisWorkbook.Sheets("TbTrBarang").Unprotect
.Cells(2, 21).Value = ">0"
JmlMasuk = Application.WorksheetFunction.DSum(ThisWorkbook.Sheets("TbTrBarang").Range("A1").CurrentRegion, "Jumlah", ThisWorkbook.Sheets("dummy").Range("T1:U2"))
TBMASUK = JmlMasuk
.Cells(2, 21).Value = "<0"
JmlKeluar = Application.WorksheetFunction.DSum(ThisWorkbook.Sheets("TbTrBarang").Range("A1").CurrentRegion, "Jumlah", ThisWorkbook.Sheets("dummy").Range("T1:U2"))
TBKELUAR = -1 * JmlKeluar
ThisWorkbook.Sheets("TbTrBarang").Protect
JmlSisa = JmlMasuk + JmlKeluar
TBSISA = JmlSisa
If JmlSisa < 0 Then
TBSISA.BackColor = &HFF&
Else
TBSISA.BackColor = &H80000010&
End If
End With
On Error GoTo 0
End With
End Sub

Makasih sebelumnya..