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

Module CRUD MySql dengan VB.NET

CRUD (CREATE, READ, UPDATE, DELETE) merupakan bagian yang tidak mungkin terpisahkan dari pemrograman, apalagi jika program yang digunakan sangat tergantung kepada database. berikut adalah module CRUD VB.NET dangan database MYSQL

Imports MySql.Data.MySqlClient
Module modCrud

    ''declaring a string
    Public result As String
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand
    Public rdr As MySqlDataReader
    Public rdr2 As MySqlDataReader
    Public rdt As DataTable

    'INSERT
    Public Sub cInsert(ByVal strSql As String)

        Try
            With cmd2
                .Connection = conn
                .CommandTimeout = 0
                .CommandText = strSql

                'execute the data
                result = cmd2.ExecuteNonQuery
            End With

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

    'SELECT
    Public Sub cSelect(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                rdr = cmd.ExecuteReader
            End With
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    'UPDATE
    Public Sub cUpdate(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

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

    'DELETE
    Public Sub cDelete(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

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


    End Sub


    'SELECT DATA untuk Gridview
    Public Sub PopDataGrid(ByVal strSql As String, gv As DataGridView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using dt As New DataTable()
                    sda.Fill(dt)
                    gv.DataSource = dt
                End Using
            End Using
        End Using
    End Sub

    'SELECT DATA untuk Listview1
    Public Sub PopDataLv(ByVal strSql As String, Lv As ListView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using dt As New DataTable()
                    sda.Fill(dt)
                    Dim itemctr As Integer
                    For itemctr = 0 To dt.Rows.Count - 1
                        Lv.Items.Add(dt.Rows(itemctr)(1))
                    Next
                End Using
            End Using
        End Using

    End Sub

    'SELECT DATA untuk Listview2
    Sub FillListView(ByVal strSql As String, Lv As ListView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using ds As New DataSet()
                    sda.Fill(ds)

                    Dim c As DataColumn
                    For Each c In ds.Tables(0).Columns

                        'adding names of columns as Listview columns
                        Dim h As New ColumnHeader
                        h.Text = c.ColumnName
                        Lv.Columns.Add(h)
                    Next
                    Dim dt As DataTable = ds.Tables(0)
                    Dim str(ds.Tables(0).Columns.Count) As String
                    'adding Datarows as listview Grids
                    Dim rr As DataRow
                    For Each rr In dt.Rows
                        For col As Integer = 0 To ds.Tables(0).Columns.Count - 1

                            str(col) = rr(col).ToString()
                        Next
                        Dim ii As New ListViewItem(str)
                        Lv.Items.Add(ii)
                        'showing the number of records still added
                    Next

                End Using
            End Using
        End Using
    End Sub

End Module

==========================================
Untuk penggunaannya tinggal panggil fungsi tersebut, contoh 

      cSELECT("SELECT * FROM data)
      Do While rdr.read()
             txtData1.text = rdr.item("data1")
             txtData2.text = rdr.item("data2")
      loop
      rdr.close()

==========================================

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

Module CRUD

Imports MySql.Data.MySqlClient
Module modCrud

    ''declaring a string
    Public result As String
    Public cmd As New MySqlCommand
    Public cmd2 As New MySqlCommand
    Public rdr As MySqlDataReader
    Public rdr2 As MySqlDataReader
    Public rdt As DataTable
    Public Sub cCall(ByVal strSql As String)

        Try
            With cmd2
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                'execute the data
                result = cmd2.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Public Sub cInsert(ByVal strSql As String)

        Try
            With cmd2
                .Connection = conn
                .CommandTimeout = 0
                .CommandText = strSql

                'execute the data
                result = cmd2.ExecuteNonQuery
            End With

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    'for holding the data to retrieve.
    Public Sub cSelect(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                rdr = cmd.ExecuteReader
            End With
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    'Fungsi Populate GridView
    'tanggal 18-08-16
    Public Sub PopDataGrid(ByVal strSql As String, gv As DataGridView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using dt As New DataTable()
                    sda.Fill(dt)
                    gv.DataSource = dt
                End Using
            End Using
        End Using
    End Sub
    'Fungsi Populate Listview
    'tanggal 18-08-16
    Public Sub PopDataLv(ByVal strSql As String, Lv As ListView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using dt As New DataTable()
                    sda.Fill(dt)
                    Dim itemctr As Integer
                    For itemctr = 0 To dt.Rows.Count - 1
                        Lv.Items.Add(dt.Rows(itemctr)(1))
                    Next
                End Using
            End Using
        End Using


    End Sub
    Sub FillListView(ByVal strSql As String, Lv As ListView)
        Using cmd As New MySqlCommand(strSql, conn)
            cmd.CommandType = CommandType.Text
            Using sda As New MySqlDataAdapter(cmd)
                Using ds As New DataSet()
                    sda.Fill(ds)

                    Dim c As DataColumn
                    For Each c In ds.Tables(0).Columns

                        'adding names of columns as Listview columns
                        Dim h As New ColumnHeader
                        h.Text = c.ColumnName
                        Lv.Columns.Add(h)
                    Next
                    Dim dt As DataTable = ds.Tables(0)
                    Dim str(ds.Tables(0).Columns.Count) As String
                    'adding Datarows as listview Grids
                    Dim rr As DataRow
                    For Each rr In dt.Rows
                        For col As Integer = 0 To ds.Tables(0).Columns.Count - 1

                            str(col) = rr(col).ToString()
                        Next
                        Dim ii As New ListViewItem(str)
                        Lv.Items.Add(ii)
                        'showing the number of records still added
                    Next

                End Using
            End Using
        End Using
    End Sub

    Public Sub cSelect2(ByVal strSql As String)
        Dim conn As New MySqlConnection
        Dim cmd As New MySqlCommand
        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                rdr2 = cmd.ExecuteReader
            End With
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    'updating the data from the database.
    Public Sub cUpdate(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

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

    'deleting the data from the database
    Public Sub cDelete(ByVal strSql As String)

        Try
            With cmd
                .Connection = conn
                .CommandText = strSql
                .CommandTimeout = 0
                result = cmd.ExecuteNonQuery
            End With

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

    End Sub

End Module


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