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 !!!