MENAMBAHKAN FOTO PADA KARTU PESERTA - EXCEL VBA

Private Sub ComboBox1_Change()

Worksheets("TAMPILKAN").Select

ComboBox1.List = Sheets("Data").Range("A6:A100").Value

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

On Error Resume Next

    Dim Filter As String, Title As String, FileX As String

    X.SetFocus

    caridata = Me.ComboBox1.Value

    With Worksheets("DATA").Range("A6:A100")

    Set c = .Find(caridata, LookIn:=xlValues)

    If Not c Is Nothing Then

    Baris = c.Row

    Me.TextBox1.Value = Worksheets("DATA").Cells(Baris, 2).Value

    Me.TextBox2.Value = Worksheets("DATA").Cells(Baris, 3).Value

    Me.TextBox3.Value = Worksheets("DATA").Cells(Baris, 4).Value

    Me.TextBox4.Value = Worksheets("DATA").Cells(Baris, 5).Value

    Else

    ComboBox1 = ""

    TextBox1 = ""

    TextBox2 = ""

    Image1.Picture = LoadPicture

    End If

    End With

    Application.ScreenUpdating = True

    DataFoto = TextBox1.Value

    Files = ActiveWorkbook.Path & "\FOTO\" & DataFoto & ".jpg"

    Image1.Picture = LoadPicture(Files)

    Application.ScreenUpdating = True

With Sheets("TAMPILKAN")

      .OLEObjects("Image1").Object.Picture = Me.Image1.Picture

End With

Worksheets("TAMPILKAN").Cells(4, 4).Value = Me.ComboBox1.Value

 Worksheets("TAMPILKAN").Cells(5, 4).Value = Me.TextBox1.Value

  Worksheets("TAMPILKAN").Cells(6, 4).Value = Me.TextBox2.Value

 Worksheets("TAMPILKAN").Cells(7, 4).Value = Me.TextBox3.Value

 Worksheets("TAMPILKAN").Cells(8, 4).Value = Me.TextBox4.Value

  End Sub

Private Sub CommandButton1_Click()

Worksheets("DATA").Select

  With Sheets("DATA")

Dim irow As Long

'Deklarasi  irow  input atau mengisi  baris terakhir pada sheet1

irow = Cells(Rows.Count, 2).End(xlUp).Offset(1, 2).Row

Cells(irow, 2).Value = TextBox1.Value

Cells(irow, 3).Value = TextBox2.Value

Cells(irow, 4).Value = TextBox3.Value

Cells(irow, 5).Value = TextBox4.Value

End With

CommandButton2_Click

With UserInput

For t = 1 To 4

.Controls("textbox" & t).Text = ""

Next

End With

'Range("a6:a50").Value = ""

Sheets("DATA").Range("a1") = Application.CountA(Range("B6:B50"))

    No = 0

For NOMOR = 1 To Range("a1")

No = No + 1

Cells(No + 5, 1).Value = No

Next NOMOR

End Sub

Private Sub CommandButton2_Click()

 If TextBox1.Value = "" Then

 MsgBox "Maaf Nama Foto Belum diisi", vbCritical

 Else

   On Error Resume Next

    Dim Filter As String, Title As String, FileIROW As String

    Dim SourceFile, DestinationFile

    irow.SetFocus

    Filter = "jpg Images File Only(*.jpg),*.jpg,"

    FileIROW = Application.GetOpenFilename(Filter, , Title)

    NamaFile = TextBox1.Value

    ActiveWorkbook.Image1.Picture = LoadPicture(FileIROW)

    Image1.Picture = LoadPicture(FileIROW)

    DestinationFile = ActiveWorkbook.Path & "\FOTO\" & NamaFile & ".jpg"

    FileCopy FileIROW, DestinationFile

    End If

    End Sub

Private Sub UserForm_Initialize()

ComboBox1.List = Sheets("Data").Range("A6:A100").Value

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

End Sub


UNDUH SAMPEL FILE xlsm >>>>   disini

Demikian semoga bermanfaat !!!

USERFORM INPUT TAMPILKAN SERTA EDIT DATA DAN FOTO

MEMBUAT USERFORM 

INPUT TAMPILKAN SERTA EDIT DATA DAN FOTO

Untuk membuat userform Input , tampilkan serta edit data dan foto pertama kita siapkan  3 buah wookbook dan satu folder untuk tempat penyimpanan data foto

pastikan nama foto dalam folder foto sama persis sesuai nama data di worksheet

kemudian kita akan membuat 3 userform yang kita simpan pada wookbook masing masing 

Simak Materinya pada halaman berikut ini :Userform Input data dan foto

BELAJAR USERFORM EDIT DATA DAN FOTO DI EXCEL

Buatlah sebuah Userform yang terdiri dari 2 CommandButton

satu untuk tombol input data dan satu lagi untuk input foto

yang mana tombol kedua akan disembunyikan namun akan dipanggil otomatis ketika tombol input di klik

Pastekan kode berikut pada CommandButton1

Private Sub CommandButton1_Click()

 If TextBox1.Value = "" Then

 MsgBox "Maaf Nama Foto Belum diisi", vbCritical

 Else

   On Error Resume Next

    Dim Filter As String, Title As String, FileIROW As String

    Dim SourceFile, DestinationFile

    irow.SetFocus

    Filter = "jpg Images File Only(*.jpg),*.jpg,"

    FileIROW = Application.GetOpenFilename(Filter, , Title)

    NamaFile = TextBox1.Value

    ActiveWorkbook.Image1.Picture = LoadPicture(FileIROW)

    Image1.Picture = LoadPicture(FileIROW)

    DestinationFile = ActiveWorkbook.Path & "\FOTO\" & NamaFile & ".jpg"

    FileCopy FileIROW, DestinationFile

    End If

    CommandButton3_Click

        End Sub

Pastekan kode berikut pada CommandButton2

Private Sub CommandButton2_Click()

 Data = ComboBox1.Value

With Worksheets("data").Range("A6:A50")

Set c = .Find(Data, LookIn:=xlValues)

If Not c Is Nothing Then

Baris = c.Row

Worksheets("data").Cells(Baris, 1).Value = ComboBox1.Value

Worksheets("data").Cells(Baris, 2).Value = TextBox1.Value

Worksheets("data").Cells(Baris, 3).Value = TextBox2.Value

Worksheets("data").Cells(Baris, 4).Value = TextBox3.Value

Worksheets("data").Cells(Baris, 5).Value = TextBox4.Value

End If

End With

ComboBox1.SetFocus

    Image1.Picture = LoadPicture

    ComboBox1.Value = ""

     TextBox1.Value = ""

      TextBox2.Value = ""

       TextBox3.Value = ""

End Sub

Pastekan kode berikut pada Combobox1

Private Sub ComboBox1_Change()

ComboBox1.List = Sheets("Data").Range("A6:A100").Value

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

On Error Resume Next

    Dim Filter As String, Title As String, FileX As String

    X.SetFocus

    caridata = Me.ComboBox1.Value

    With Worksheets("DATA").Range("A6:A100")

    Set c = .Find(caridata, LookIn:=xlValues)

    If Not c Is Nothing Then

    Baris = c.Row

    Me.TextBox1.Value = Worksheets("DATA").Cells(Baris, 2).Value

    Me.TextBox2.Value = Worksheets("DATA").Cells(Baris, 3).Value

    Me.TextBox3.Value = Worksheets("DATA").Cells(Baris, 4).Value

     Me.TextBox4.Value = Worksheets("DATA").Cells(Baris, 5).Value

    Else

    ComboBox1 = ""

    TextBox1 = ""

    TextBox2 = ""

    Image1.Picture = LoadPicture

    End If

    End With

    Application.ScreenUpdating = True

    DataFoto = TextBox1.Value

    Files = ActiveWorkbook.Path & "\FOTO\" & DataFoto & ".jpg"

    Image1.Picture = LoadPicture(Files)

    Application.ScreenUpdating = True

'With Sheets("data")

      '.OLEObjects("Image1").Object.Picture = Me.Image1.Picture

'End With

End Sub

Pastekan kode berikut pada Userform

Private Sub UserForm_Initialize()

ComboBox1.List = Sheets("Data").Range("A6:A100").Value

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

End Sub

Download sampel file  :   userform kontrol data dan foto

BELAJAR USERFORM MENAMPILKAN DATA DAN FOTO

Pastekan kode berikut pada Combobox1

Private Sub ComboBox1_Change()

ComboBox1.List = Sheets("Data").Range("A6:A100").Value

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

On Error Resume Next

    Dim Filter As String, Title As String, FileX As String

    X.SetFocus

    caridata = Me.ComboBox1.Value

    With Worksheets("DATA").Range("A6:A100")

    Set c = .Find(caridata, LookIn:=xlValues)

    If Not c Is Nothing Then

    Baris = c.Row

    Me.TextBox1.Value = Worksheets("DATA").Cells(Baris, 2).Value

    Me.TextBox2.Value = Worksheets("DATA").Cells(Baris, 3).Value

    Me.TextBox3.Value = Worksheets("DATA").Cells(Baris, 4).Value

    Me.TextBox4.Value = Worksheets("DATA").Cells(Baris, 5).Value

    Else

    ComboBox1 = ""

    TextBox1 = ""

    TextBox2 = ""

    Image1.Picture = LoadPicture

    End If

    End With

    Application.ScreenUpdating = True

    DataFoto = TextBox1.Value

    Files = ActiveWorkbook.Path & "\FOTO\" & DataFoto & ".jpg"

    Image1.Picture = LoadPicture(Files)

    Application.ScreenUpdating = True

'With Sheets("data")

      '.OLEObjects("Image1").Object.Picture = Me.Image1.Picture

'End With

End Sub

Pastekan kode berikut pada Userform

Private Sub UserForm_Initialize()

ComboBox1.List = Sheets("Data").Range("A6:A100").Value

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

End Sub

BELAJAR USERFORM INPUT DATA DAN FOTO

Buatlah sebuah Userform yang terdiri dari 2 CommandButton

satu untuk tombol input data dan satu lagi untuk input foto

yang mana tombol kedua akan disembunyikan namun akan dipanggil otomatis ketika tombol input di klik

Pastekan kode berikut pada CommandButton1

Private Sub CommandButton1_Click()

With ActiveSheet

Dim irow As Long

'Deklarasi  irow  input atau mengisi  baris terakhir pada sheet1

irow = Cells(Rows.Count, 2).End(xlUp).Offset(1, 2).Row

Cells(irow, 2).Value = TextBox1.Value

Cells(irow, 3).Value = TextBox2.Value

Cells(irow, 4).Value = TextBox3.Value

Cells(irow, 5).Value = TextBox4.Value

End With

CommandButton2_Click

End With

End Sub

Pastekan kode berikut pada CommandButton 2

Private Sub CommandButton2_Click()

 If TextBox1.Value = "" Then

 MsgBox "Maaf Nama Foto Belum diisi", vbCritical

 Else

   On Error Resume Next

    Dim Filter As String, Title As String, FileIROW As String

    Dim SourceFile, DestinationFile

    irow.SetFocus

    Filter = "jpg Images File Only(*.jpg),*.jpg,"

    FileIROW = Application.GetOpenFilename(Filter, , Title)

    NamaFile = TextBox1.Value

    ActiveWorkbook.Image1.Picture = LoadPicture(FileIROW)

    Image1.Picture = LoadPicture(FileIROW)

    DestinationFile = ActiveWorkbook.Path & "\FOTO\" & NamaFile & ".jpg"

    FileCopy FileIROW, DestinationFile

    End If

        End Sub

Pastekan kode berikut pada Userform

Private Sub UserForm_Initialize()

ListBox1.ColumnCount = 4

ListBox1.ColumnWidths = 35 & ";" & 100 & ";" & 100 & ";" & 80

ListBox1.RowSource = "data"

Label2.Caption = Cells(5, 2).Value

Label3.Caption = Cells(5, 3).Value

Label4.Caption = Cells(5, 4).Value

Label5.Caption = Cells(5, 5).Value

End Sub

Halaman berikutnya >>>>  userform tampilkan data