rahmatdcc.blogspot.com

Sub CapitalTb()
Dim oText(100) As String
Dim i As Integer

    For Each obj In Me.Controls
        If Left(obj.Name, 3) = "txt" Then
            obj.Text = UCase(obj.Text)
            obj.Text = Replace(obj.Text, "'", "`")
        End If
    Next
          
End Sub

Function HanyaAngka(ByRef KeyAscii As Integer)
    If ((KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57) Then
        MsgBox "Isilah dengan angka!", vbExclamation, App.Title
        KeyAscii = 0
    End If
End Function

Function HijriDate()
Dim xTgl As String
Dim xHijri As String
Dim days As DayConstants

    xTgl = Format(xLoginDate, "yyyy-mm-dd")
    days = Date - CDate(xTgl)
    days = days + 1
    DateTime.Calendar = vbCalHijri
    xHijri = Format(Date - days, "dd-mm-yyyy")
    xSistemHijriDate = xHijri
        If Mid(xHijri, 4, 2) = "01" Then xHijri = Replace(xHijri, "-01-", " Muharram ")
        If Mid(xHijri, 4, 2) = "02" Then xHijri = Replace(xHijri, "-02-", " Safar ")
        If Mid(xHijri, 4, 2) = "03" Then xHijri = Replace(xHijri, "-03-", " Rabiul Awal ")
        If Mid(xHijri, 4, 2) = "04" Then xHijri = Replace(xHijri, "-04-", " Rabiul Akhir ")
        If Mid(xHijri, 4, 2) = "05" Then xHijri = Replace(xHijri, "-05-", " Jumadal Ula ")
        If Mid(xHijri, 4, 2) = "06" Then xHijri = Replace(xHijri, "-06-", " Jumadal Tsani ")
        If Mid(xHijri, 4, 2) = "07" Then xHijri = Replace(xHijri, "-07-", " Rajab ")
        If Mid(xHijri, 4, 2) = "08" Then xHijri = Replace(xHijri, "-08-", " Sya'ban ")
        If Mid(xHijri, 4, 2) = "09" Then xHijri = Replace(xHijri, "-09-", " Ramadhan ")
        If Mid(xHijri, 4, 2) = "10" Then xHijri = Replace(xHijri, "-10-", " Syawwal ")
        If Mid(xHijri, 4, 2) = "11" Then xHijri = Replace(xHijri, "-11-", " Dzulkaidah ")
        If Mid(xHijri, 4, 2) = "12" Then xHijri = Replace(xHijri, "-12-", " Dzulhijjah ")
    xLoginHijri = xHijri
    DateTime.Calendar = vbCalGreg
   
End Function

Function CpuId() As String
Dim computer As String
Dim wmi As Variant
Dim processors As Variant
Dim cpu As Variant
Dim cpu_ids As String

    computer = "."
    Set wmi = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & _
        computer & "\root\cimv2")
    Set processors = wmi.ExecQuery("Select * from " & _
        "Win32_Processor")

    For Each cpu In processors
        cpu_ids = cpu_ids & ", " & cpu.ProcessorID
    Next cpu
    If Len(cpu_ids) > 0 Then cpu_ids = Mid$(cpu_ids, 3)

    CpuId = cpu_ids
End Function

Sub TreeALL()
Dim nodX As Node
Dim nodX2 As Node
Dim s As String
Dim i As Long
Dim xParent As Long
Dim xParent2 As Long
  
    nMenu = 0
    For Each obj In frmMain.Controls
        If Left(obj.Name, 2) = "mn" Then
            If Mid(obj.Name, 3, 1) = "0" Then menuName(nMenu) = Mid(obj.Name, 4, 10)
                If Mid(obj.Name, 3, 1) = "1" Then menuName(nMenu) = Mid(obj.Name, 3, 10)
                    menuCaption(nMenu) = Replace(obj.Caption, "&", "")
                    menuCaption(nMenu) = obj.Name & ". " & SplitText(menuCaption(nMenu), ".", 2)
                    menuCaption(nMenu) = Replace(menuCaption(nMenu), "mn", "")
                    nMenu = nMenu + 1
        End If
    Next
          
        For i = 0 To nMenu - 1
                If Len(menuName(i)) = 1 Then
                    xParent = Left(menuName(i), 1)
                    Set nodX = treeview1.Nodes.Add(, , "mn" & xParent, menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                  
                ElseIf Len(menuName(i)) = 2 Then
                    xParent = Left(menuName(i), 2)
                    Set nodX = treeview1.Nodes.Add(, , "mn" & xParent, menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                  
                ElseIf Len(menuName(i)) > 2 And Len(menuName(i)) < 5 Then
                    Set nodX = treeview1.Nodes.Add("mn" & xParent, tvwChild, , menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                       
                ElseIf Len(menuName(i)) = 5 Then
                    Set nodX2 = treeview1.Nodes.Add(nodX, tvwChild, , menuCaption(i))
                    nodX2.Checked = False
                    nodX2.Expanded = True
                End If
            Next
            treeview1.BorderStyle = vbFixedSingle
            Call TreeBold
          
End Sub
Sub TreeGroup()
Dim i As Integer
Dim j As Integer
Dim xMenuGroup As String
Dim xMenuMaster As String

    For i = 1 To Me.ListView1.ListItems.Count
        xMenuGroup = Me.ListView1.ListItems.Item(i).ListSubItems(2).Text
        For j = 1 To Me.treeview1.Nodes.Count
            xMenuMaster = SplitText(Me.treeview1.Nodes.Item(j).Text, ".", 1)
            If xMenuGroup = xMenuMaster Then Me.treeview1.Nodes.Item(j).Checked = True
        Next
    Next
  
End Sub
Sub TreeBold()
Dim i As Integer

    For i = 1 To Me.treeview1.Nodes.Count
        If Len(SplitText(Me.treeview1.Nodes(i).Text, ".", 1)) = 2 Then Me.treeview1.Nodes(i).Bold = True
    Next
  
End Sub