RSS

ID Auto Number di Vb.net

Membuat "Automatic ID Number" (nomor ID Otomatis) sering dilakukan dalam hal pemrograman. jika pemrogramannya berbasis client-server, atau berbasis databases, pembuatan ID numbernya bisa dilakukan di dua sisi, disisi aplikasi pemrogramnnya atau disisi basis datanya (database). berikut cara pembuatan auto number menggunakan Vb.net. 

1. Buatlah objek "txtKode"
2. Copy script dibawah ini!
    Sub IdReg()
        'Membuat kode dengan 6 digit
        txtKode.Text = Format(GenerateCD, "000000")
    End Sub

    Public Function GenerateCD() As Integer
      
        'contoh pengambilan dari tabel "data_barang"
        cSelect("SELECT MAX(right(barang_kode, 6)) as Nomor " & _
                "FROM data_barang ")
        rdr.Read()
        If rdr.HasRows Then
            If IsDBNull(rdr.Item("Nomor")) = True Then
                GenerateCD = 1
            Else
                GenerateCD = Val(rdr.Item("Nomor")) + 1
            End If
        Else
            GenerateCD = 1
        End If
        rdr.Close()

    End Function

Cara Panggil ==> call idreg()

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Mengisi data di Listview VB.NET

        Sub TabelGroup()
        With Me.ListView1
            .FullRowSelect = True
            .GridLines = True
            .AllowColumnReorder = True
            .CheckBoxes = True
            .HoverSelection = True
            .View = Windows.Forms.View.Details

            With .Columns
                .Add("", 0)
                .Add("Kode", 60, HorizontalAlignment.Center)
                .Add("Nama Group", 200)
                .Add("Tipe1", 0)
                .Add("Tipe", 150)
                .Add("Jumlah Menu", 100, HorizontalAlignment.Center)
                .Add("Keterangan", 480)
            End With

        End With
    End Sub
    Sub DataGroup()

        Me.Cursor = Cursors.WaitCursor
        cSelect("SELECT group_kode, group_nama, group_akses, group_keterangan, " & _
                "group_akses, GetGroupJenis(group_akses) as Tipe, " & _
                "GetGroupJumlah(group_kode) as JumlahMenu " & _
                "FROM data_pengguna_group")

        Me.ListView1.Items.Clear()
        If rdr.HasRows Then
            Do While rdr.Read
                Dim ls As New ListViewItem()
                ls.SubItems.Add(rdr.Item("group_kode").ToString())
                ls.SubItems.Add(rdr.Item("group_nama").ToString())
                ls.SubItems.Add(rdr.Item("group_akses").ToString())
                ls.SubItems.Add(rdr.Item("Tipe").ToString())
                ls.SubItems.Add(rdr.Item("JumlahMenu").ToString())
                ls.SubItems.Add(rdr.Item("group_keterangan").ToString())
                ListView1.Items.Add(ls)
            Loop
        End If
        rdr.Close()
        Call lvWarna(Me.ListView1)
        Me.Cursor = Cursors.Default

    End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Kumpulan Fungsi Manipulasi String Vb.net

Imports MySql.Data.MySqlClient
Imports System.IO

Module modFungsi
    Public result As String
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand

    Public Sub DeleteFile(namaFile As String)
        Try
            If File.Exists(namaFile) Then
                File.Delete(namaFile)
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Public Sub LogValidasi(Lv As ListView, kode As String, nama As String, err As String)
        Dim ls As New ListViewItem()
        ls.SubItems.Add(kode)
        ls.SubItems.Add(nama)
        ls.SubItems.Add(err)
        Lv.Items.Add(ls)
    End Sub
    Public Sub SimpanValidasi(id As String, kode As String, nama As String, err As String)

        Dim strSql As String
        strSql = "INSERT INTO temp_slik_error SET " & _
                 "temp_id = '" & id & "', temp_kode  = '" & kode & _
                 "', temp_nama = '" & nama & "', temp_error = '" & err & "'"
        Try
            With cmd2
                .Connection = conn
                .CommandTimeout = 0
                .CommandText = strSql

                'execute the data
            End With
            result = cmd2.ExecuteNonQuery

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Function TimeDifCalc(d1 As DateTime, d2 As DateTime)
        d1 = DateTime.Parse(d1)
        d2 = DateTime.Parse(d2)
        Dim difference As TimeSpan = d2 - d1
        'round down total hours to integer'
        Dim hours = Math.Floor(difference.TotalHours)
        Dim minutes = Math.Abs(difference.Minutes)
        Dim seconds = difference.Seconds
        Dim timeleft As String = Format(hours, "00") + " h " + Format(minutes, "00") + " m " + Format(seconds, "00") + " s "
        If Int(seconds) < 0 Then
            timeleft = "00 h 00 m 00 s (Time Out)"
        End If
        Return timeleft

    End Function
    Function LastDayOfMonth(aDate As DateTime) As Date
        Return New DateTime(aDate.Year, _
                            aDate.Month, _
                            DateTime.DaysInMonth(aDate.Year, aDate.Month))
    End Function

    Sub PesanHapus()
        MsgBox("Data telah dihapus", MsgBoxStyle.Information, Application.ProductName)
    End Sub
    Sub PesanSimpan()
        MsgBox("Data telah disimpan", MsgBoxStyle.Information, Application.ProductName)
    End Sub
    Function strReplace(str As String, vOld As String, vNew As String)
        str = str.Replace(vOld, vNew)
        Return str
    End Function
    Function strReplaceKolek(str As String)
        On Error Resume Next
        str = str.Replace("L", "1")
        str = str.Replace("KL", "3")
        str = str.Replace("D", "4")
        str = str.Replace("M", "5")
        Return str
    End Function
    Function strReplaceBadan(str As String)
        On Error Resume Next
        str = str.Replace("PT", "")
        str = str.Replace("KOPERASI", "")
        str = str.Replace("CV", "")
        str = str.Replace("UD", "")
        str = str.Replace(".", "")
        str = str.Replace("-", "")
        Return str
    End Function
    Function strReplaceSlik(str As String)
        On Error Resume Next
        If Len(str) > 0 Then
            str = str.Replace(".", "")
            str = str.Replace(",", "")
            str = str.Replace(":", "")
            str = str.Replace(";", "")
            str = str.Replace("-", "")
            str = str.Replace("/", "")
            str = str.Replace("\", "")
            str = str.Replace("?", "")
            str = str.Replace("+", "")
            str = str.Replace("_", "")
            str = str.Replace("  ", "")
            str = str.Replace("   ", "")
            str = str.Replace("'", "")
            str = str.Replace("*", "")
            str = str.Replace("**", "")
            str = str.Replace("***", "")
            str = str.Replace("****", "")
        End If
        Return str
    End Function
    Function tbPersen(oText As TextBox)
        oText.Text = fDesimal(oText.Text)
        oText.Select(oText.Text.Length, 0)
        Return oText.Text
    End Function
    Function tbRupiah(oText As TextBox)
        oText.Text = fRupiah(oText.Text)
        oText.Select(oText.Text.Length, 0)
        Return oText.Text
    End Function
    Function fDbDesimal(byText As String)
        Dim angka As String
        angka = Replace(byText, ",", ".")
        Return angka
    End Function
    Function fDesimal(byText As Decimal)
        Dim angka As String
        angka = Format(byText, "#,##0.#0")
        Return angka
    End Function
    Function fInteger(ByVal byText As Integer)
        Dim angka As Integer
        angka = Convert.ToInt32(angka)
        Return angka
    End Function
    Function fRupiah(byText As Double)
        Dim angka As String
        angka = Format(byText, "#,##0")
        Return angka
    End Function
    Function fDbRupiah(byText As String)
        Dim angka As String
        angka = Replace(byText, ".", "")
        Return angka
    End Function
    Function FormatTglDb(ByVal byText As Date)
        Dim tanggal As String
        tanggal = Format(byText, "yyyy-MM-dd")
        Return tanggal
    End Function
    Function FormatTgl(byText As Date)
        Dim tanggal As String
        tanggal = Format(byText, "dd-MM-yyyy")
        Return tanggal
    End Function
    Public Sub ClearTB(frm As Form)

        For Each Control In frm.Controls
            If TypeOf Control Is TextBox Then Control.Text = ""
            If TypeOf Control Is ComboBox Then Control.text = ""
            If TypeOf Control Is Date Then Control.value = Now
        Next Control

    End Sub
    Function sLeft(ByVal Str As String, ByVal Len1 As Integer)
        Str = Left(Str, Len1)
        Return Str
    End Function
    Function sMid(ByVal Val As String, ByVal Len As Integer)
        Return Val.Substring(Val.Length / 2 - Len / 2, Len)
    End Function

    Function sRight(ByVal Val As String, ByVal Len As Integer)
        Return Val.Substring(Val.Length - Len, Len)
    End Function
    'Fungsi split string
    'Tanggal : 13-08-2016
    Function SplitText(ByVal text As String, ByVal limiter As String, ByVal ke As Integer)
        On Error Resume Next
        Return Split(text, Trim(limiter))(ke)
    End Function
End Module


  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Module Export Listview to Excel Vb.net

Export data dari listview ke format excel sangat sering dilakukan, apalagi data tersebut terkait dengan data operasional harian yang akan di modifikasi dengan aplikasi lain. Microsoft excel merupakan salah satu aplikasi yang paling sering digunakan untuk mengedit dokumen dalam bentuk data. berikut cara export data dari listview ke microsoft excel dengan VB.NET


Yang perlu disedikan adalah: 
  1. Object Listview
  2. Object Progress Bar
  3. Copy module ExportToExcel
  4. Panggil dengan "Call ExportToExcel(Listview1, ProgressBar1)
'Module ExportToEcel VB.NET

Imports Excel = Microsoft.Office.Interop.Excel

Module modExcel
    Public Sub ExportToExcel(li As ListView, pb As ProgressBar)
        Try
            Dim objExcel As New Excel.Application
            'objExcel.Visible = True
            objExcel.UserControl = True
            Dim oldCI As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture
            System.Threading.Thread.CurrentThread.CurrentCulture = New System.Globalization.CultureInfo("en-US")

            Dim bkWorkBook As Excel.Workbook
            Dim shWorkSheet As Excel.Worksheet
            Dim i As Integer
            Dim j As Integer

            objExcel = New Excel.Application
            bkWorkBook = objExcel.Workbooks.Add
            shWorkSheet = objExcel.Sheets.Add
            'shWorkSheet.Name = "Sheet1"
            shWorkSheet = CType(bkWorkBook.ActiveSheet, Excel.Worksheet)

            pb.Visible = True
            pb.Maximum = li.Items.Count
            pb.Value = 0

            'Masukkan Header
            For i = 0 To li.Columns.Count - 1
                shWorkSheet.Cells(1, i + 1) = li.Columns(i).Text
            Next

            'Masukkan isi
            For i = 0 To li.Items.Count - 1
                pb.Value += 1
                For j = 0 To li.Items(i).SubItems.Count - 1
                    If sLeft(li.Items(i).SubItems(j).Text, 1) = "0" Then
                        shWorkSheet.Cells(i + 2, j + 1) = "'" & li.Items(i).SubItems(j).Text
                    Else
                        shWorkSheet.Cells(i + 2, j + 1) = li.Items(i).SubItems(j).Text
                    End If
                Next
            Next

            objExcel.Visible = True

            pb.Visible = False
            System.Threading.Thread.CurrentThread.CurrentCulture = oldCI

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

End Module


  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS