photo yang konect ke folder berubah tanpa tombol button

  1. 5 minggu lalu

    mohon pencerahanya para master..
    1. cara supaya photo yang konect ke folder berubah tanpa tombol button(sementara bis berubah klo ditombol)
    berikkut filenya, terima kasih sebelumnya

  2. manweljs_

    Agu 20 Terverifikasi + 5.020 Poin

    @mumuskh

    filenya tidak terlampir

  3. maaf ini filenya mas..

    Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim Filter As String, Title As String, FileX As String
    Dim SourceFile, DestinationFile

    x.SetFocus
    Filter = "JPG Image Files Only(*.jpg),*.jpg,"
    'Title = "Silahkan Pilih Logo "
    FileX = Application.GetOpenFilename(Filter, , Title)
    NamaFile = Range("U1")

    Sheets("INDUK").Image1.Picture = LoadPicture(FileX)
    Image1.Picture = LoadPicture(FileX)

    DestinationFile = ActiveWorkbook.Path & "\Photo\" & NamaFile & ".jpg"
    FileCopy FileX, DestinationFile
    End Sub
    Private Sub SpinButton1_Change()
    On Error GoTo GbKosong
    SpinButton1.Min = 1
    SpinButton1.Max = 1000000000
    Range("B1") = SpinButton1

    Application.ScreenUpdating = False
    NamaData = Range("E7")
    Files = ActiveWorkbook.Path & "\Photo\" & NamaData & ".jpg" '
    Image1.Picture = LoadPicture(Files)
    Application.ScreenUpdating = True

    Exit Sub
    GbKosong:
    Image1.Picture = Image2.Picture
    End Sub

  4. Caton

    Agu 20 Terverifikasi Indonesia + 11.522 Poin

    @mumuskh ... cara supaya photo yang konect ke folder berubah tanpa tombol button ...

    Saya asumsikan maksud mas @mumuskh adalah menampilkan photo sesuai Nama atau Nomor Induk Siswa (atau apa saja yang menjadi ketetapan penerapannya) secara otomatis. Dalam hal ini, jika nomor indeks pada sel B1 berubah, photo siswa ikut berubah. Demikian yang saya simpulkan. Jika demikian yang ditanyakan, mas @mumuskh bisa mencoba menggunakan script berikut (ketik atau paste pada modul objek Sheet4):

    Option Explicit
    
    '+-- Lokasi photo dan photo default!
    Private Const PHOTO_NO_PHOTO As String = "K:\Foto-Siswa\NoPicture.jpg"
    Private Const PHOTO_FOLDER As String = "K:\Foto-Siswa\4\"
    
    '+-- Untuk memeriksa batas data!
    Private m_lMaxData As Long
    
    Private Sub SpinButton1_Change()
        Dim sFileName As String
        
        '+-- Pastikan batas maksimum sesuai data dan sel acuan sudah diatur!
        If (m_lMaxData = 0) Or Len(SpinButton1.LinkedCell) = 0 Then Call Worksheet_Activate
        
        On Error Resume Next
        
        '+-- Atur nama file gambar dan terapkan!
        sFileName = PHOTO_FOLDER & "Photo" & Format$([B1], "000") & ".JPG"
        If Dir(sFileName) <> vbNullString Then
            '+-- Jika photo eksis!
            Image1.Picture = LoadPicture(sFileName)
        Else
            Image1.Picture = LoadPicture(PHOTO_NO_PHOTO)
        End If
        
        '+-- Jika terjadi kesalahan?
        If Err.Number Then
            '+-- Coba terapkan gambar standar!
            MsgBox "Terjadi kesalahan saat menetapkan photo siswa!"
            Image1.Picture = Nothing
        End If
        
        Err.Clear
        On Error GoTo 0
        
    End Sub
    
    Private Sub Worksheet_Activate()
        On Error Resume Next
        With SpinButton1
            .Min = 1
            .Max = Application.Max(ShDataBase.[A:A])
            .LinkedCell = [B1].Address
            m_lMaxData = .Max
        End With
        Err.Clear
        On Error GoTo 0
    End Sub
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        '+-- Jika sel B1 diisi secara manual, maka
        '+-- nilai maksimum adalah jumlah data!
        On Error GoTo errHandler
        
        If Target.Address = [B1].Address Then
            If Val(Target.Text) > m_lMaxData Then
                If m_lMaxData = 0 Then Call Worksheet_Activate
                Application.EnableEvents = False
                Target = m_lMaxData
                Application.EnableEvents = True
            End If
        End If
    
    errHandler:
        Err.Clear
        On Error GoTo 0
    End Sub

    Pastikan script di atas menimpa seluruh script yang sudah ada. Jika tidak ada masalah, maka hasil yang ditampilkan akan terlihat seperti berikut:

    Change photo.gif

    Pada tampilan di atas, jika nama file photo siswa tidak ditemukan, maka yang akan ditampilkan adalah gambar dengan nama file sesuai pada konstanta PHOTO_NO_PHOTO. Jika script di atas sesuai yang mas @mumuskh maksudkan, saran saya, tombol CommandButton1 (dengan caption Ganti Photo) dapat diterapkan sesuai dengan captionnya, yakni untuk mengganti photo.

    Mungkin demikian solusinya. Jika tidak sesuai, saran saya, sampaikanlah pertanyaan atau masalah dengan jelas agar dapat mudah untuk dipahami. Informasikan detil-detil yang perlu diperhatikan (seperti nama kontrol tombol dan sebagainya) ... :)

    Demikian.

  5. manweljs_

    Agu 20 Terverifikasi + 5.020 Poin
    Di sunting 5 minggu lalu oleh manweljs_

    @mumuskh

    terlampir contoh dari saya. di extrak dulu yak

    Note : maaf baru balas, tadi harus ada yg dikerjakan

  6. Di sunting 5 minggu lalu oleh mumuskh

    terima kasih banyak @Caton dan @manweljs
    semoga Alloh membalas kebaikannya dan umurnya dipanjangkan dlm keadaan sehat.Amin

    @Mas Caton
    1. stlh sy coba scrip punya @ mas Caton, tidak bs jalan, mohon bantuaanya, salahnya dimana?, berikut sy lampirkan kesalahan stlh sy coba, terima kasih

    @Masmanweljs_
    tapi masih ada yg mau sy tanyakan @manweljs, setelah sy coba colum B1 sy ganti manual dg angka no induk 2 dan 3, mak photo tidak berubah apa ada caranya?, mohon pencerahannya

  7. manweljs_

    Agu 21 Terverifikasi + 5.020 Poin
    Di sunting 5 minggu lalu oleh manweljs_

    @mumuskh

    ...setelah sy coba colum B1 sy ganti manual dg angka no induk 2 dan 3, mak photo tidak berubah apa ada caranya?...

    copy aja skripnya pada Event WorksheetChange sheet tersebut dan tambahkan logika IF, contohnya :

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo GbKosong
    If Target.Address = "$B$1" Then
    NamaData = Range("E7").Value
    Files = ActiveWorkbook.Path & "\Photo\" & NamaData & ".jpg"
    NoPhoto = ActiveWorkbook.Path & "\Photo\NoPhoto.jpg"
    
    shINDUK.Shapes("imgME").Fill.UserPicture Files
    
    Exit Sub
    GbKosong:
    shINDUK.Shapes("imgME").Fill.UserPicture NoPhoto
    End If
    End Sub

  8. Di sunting 5 minggu lalu oleh mumuskh

    terima kasih banyak bantuannya
    maaf @mas manweljs stlh sy coba mucul seperti ini, mohon pencerahannya..

  9. manweljs_

    Agu 21 Terverifikasi + 5.020 Poin

    @mumuskh

    yang di edit di module worksheet nya seperti gambar ini:

    Capture.PNG

    atau cek file terlampir

  10. terima kasih banyak @mas manweljs

  11. Caton

    Agu 21 Terverifikasi Indonesia + 11.522 Poin

    @mumuskh ... stlh sy coba scrip punya @ mas Caton, tidak bs jalan ...

    Saya balik bertanya dahulu ... :D Untuk script berikut ini:

    '+-- Lokasi photo dan photo default!
    Private Const PHOTO_NO_PHOTO As String = "K:\Foto-Siswa\NoPicture.jpg"
    Private Const PHOTO_FOLDER As String = "K:\Foto-Siswa\4\"

    [1]. Apakah mas @mumuskh punya folder K:\Foto-Siswa\? Jika tidak punya, maka ganti nama folder tersebut menjadi lokasi folder Photo yang aktual pada PC mas @mumuskh ...

    [2]. Apakah mas @mumuskh punya file gambar bernama NoPicture.jpg? Jika tidak punya, maka siapkan sebuah file gambar untuk menampilkan jika siswa belum punya photo.

    [3]. Apakah pada folder photo (misalkan K:\Foto-Siswa\) nama-nama file photo di simpan dengan pola nama Photo###.JPG (misalkan Photo001.JPG, Photo002.JPG dan seterusnya)?

    Tujuan penggunaan konstanta tersebut agar lokasi aktual photo dapat disesuaikan dan lebih fleksibel. Namun, biar gak pusing nyari masalahnya, berikut saya lampirkan yang sudah jadi ... :)

    Demikian.

 

atau Mendaftar untuk ikut berdiskusi!