• ข้อมูลส่วนตัว
  • Summary
  • แสดงสถิติ
  • แสดงกระทู้...
    • Messages
    • Topics
    • Attachments
    • Thanked Posts
    • Posts Thanked By User

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

1

ห้อง MS Access / : ต้องเปิดModuleทุกครั้งเพื่อแสดงรูป ต้องแก้ไขอย่างไรครับ

« เมื่อ: 12 ต.ค. 61 , 20:50:18 »

Private Sub Form_Open(Cancel As Integer)
    Me.TimerInterval = 150
End Sub

Private Sub Form_Timer()
    Me.TimerInterval = 0
    Me.Image1.picture = Me.pathPic
End Sub

น่าจะพอแก้ขัด 

โพสต์นี้ได้รับคำขอบคุณจาก: Note Ekkachai

4

ห้อง MS Access / : แก้โค้ดให้แสดงรูปในซับโฟลเดอร์ยังไงครับ

« เมื่อ: 20 ส.ค. 61 , 15:40:42 »

ลองดูตัวอย่างนี้ครับ สมมุติมีชื่อ Folder ใน Folder Picture 2 อันแบบนี้


เมื่อเปิดฟอร์มก็จะจัดเก็บ รายชื่อ SubFolder ลงในตารางและนำมาแสดงใน Combobox


เมื่อเลือก ชื่อ SubFolder แล้วกด Open ก็จะแสดงรูปภาพทั้งหมดที่มีใน SubFolder นั้นขึ้นมาครับ


แสดงตัวอย่างโค้ดทั้งหมด

โค๊ด: [Select]

Option Compare Database
Option Explicit

 Public Function iFileDialog() As String
 Const msoFileDialogFilePicker = 3
 Const msoFileDialogViewDetails = 2
 Dim fd As Object, varltems As Variant, flPath As Variant
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
 With fd
    .Title = "Choose"
    .InitialView = msoFileDialogViewDetails
    .Filters.Clear
    .Filters.Add "Image", "*.jpg;*.png;*.bmp"
    .Filters.Add "All Files", "*.*"
    .FilterIndex = 1
    .InitialFileName = CurrentProject.Path & "\Picture\" & Me.Combo1
    If fd.Show = True Then
        iFileDialog = Trim(.SelectedItems.Item(1))
    End If
  End With
End Function
Sub Create_Dir_List(Inputpath As String)
Dim Dbs As Database
Dim Rst As DAO.Recordset
Dim Fso, Fldr, SubFldr, F As Object
Dim CurrentSubFolderName As String

Set Dbs = CurrentDb
Set Rst = Dbs.OpenRecordset("ListTable", dbOpenDynaset)
Set Fso = CreateObject("scripting.filesystemobject")
Set Fldr = Fso.getfolder(Inputpath)

CurrentSubFolderName = Right$(Fldr.Path, Len(Fldr.Path) - InStrRev(Fldr.Path, "\"))
    With Rst
        .AddNew
        .Fields("FolderName") = CurrentSubFolderName
        .Update
     End With
For Each Fldr In Fldr.subfolders
Call Create_Dir_List(Fldr.Path)
Next Fldr
End Sub
Private Sub Combo1_GotFocus()
Me.Requery
End Sub
Private Sub Find_Click()
Call iFileDialog
End Sub
Private Sub Form_Open(Cancel As Integer)
DoCmd.SetWarnings False
DoCmd.RunSQL ("delete * from Listtable")
DoCmd.SetWarnings True
Call Create_Dir_List(CurrentProject.Path & "\Picture")
End Sub



โพสต์นี้ได้รับคำขอบคุณจาก: Note Ekkachai