Question

我正在尝试通过循环浏览预定义文件夹中的所有图像来更改Image控件.picture属性来创建图像幻灯片

C：\ IMAGES

我正在使用的代码：

    Public pixpaths As Collection
    Public pix_path As String
    Public pixnum As Integer
    Public fs As YtoFileSearch
    Public k As Integer

    Public Sub Image_set()
    Set pixpaths = New Collection
    pix_path = "C:\Images"
    Set fs = New YtoFileSearch
    With fs
      .NewSearch
      .LookIn = pix_path
      .fileName = "*.jpg"
      If fs.Execute() > 0 Then
        For k = 1 To .FoundFiles.Count
          pixpaths.Add Item:=.FoundFiles(k)
        Next k
      Else
        MsgBox "No files found!"
        DoCmd.OpenForm "Fr_Sketchpad"    ' If no images found in folder the set image from another form 'Sketchpad' image control
        Forms!Fr_Sketchpad.Visible = False
        Forms!Fr_Main!imgPixHolder.Picture = "" 'Forms!Fr_Sketchpad!Img_Std.Picture   Was getting another error here so commented this
        pixnum = 0
        Exit Sub
      End If
    End With
    'load first pix
    Forms!Fr_Main.imgPixHolder.Picture = pixpaths(1)
    pixnum = 1
    End Sub

    Public Sub Image_loop()
          If pixnum = pixpaths.Count Then
          pixnum = 1
        ElseIf pixnum = 0 Then
            Exit Sub
        Else
          pixnum = pixnum + 1
          Forms!Fr_Main!imgPixHolder.Picture = pixpaths(pixnum)
        End If
    End Sub

    Private Sub Form_Open(Cancel As Integer)
     Call Image_set
    End Sub

    Private Sub Form_Timer()
     Call Image_loop
    End Sub

Image_Set（），Image_loop（）和变量在一个模块中，并在Form_open和Form_timer事件中调用代码在一个循环周期中工作正常，但是对于下一个循环周期，它显示错误：

错误91对象变量或未设置块变量

在

If pixnum = pixpaths.Count Then

在调试模式下，当我检查pixnum的值时，它是0

[更新] 课程模块YtoFileSearch

    Option Compare Database
Option Explicit

' How this is not another proof that doing VBA is a bad idea?
' Nevertheless, we'll try to make the scripts relying on Application.FileSearch works again.

' The interface of this YtoFileSearch class aims to stick to the original
' Application.FileSearch class interface.
' Cf is https://msdn.microsoft.com/en-us/library/office/aa219847(v=office.11).aspx

' For now it do not handle recursive search and only search for files.
' More precisely the following filters are not implemented:
' * SearchSubFolders
' * MatchTextExactly
' * FileType
' If that's something you need, please create an issue so we have a look at it.

' Our class attributes.
Private pDirectoryPath As String
Private pFileNameFilter As String
Private pFoundFiles As Collection

' Set the directory in which we will search.
Public Property Let LookIn(directoryPath As String)
    pDirectoryPath = directoryPath
End Property

' Allow to filter by file name.
Public Property Let fileName(fileName As String)
    pFileNameFilter = fileName
End Property

'Property to get all the found files.
Public Property Get FoundFiles() As Collection
    Set FoundFiles = pFoundFiles
End Property

' Reset the FileSearch object for a new search.
Public Sub NewSearch()
    'Reset the found files object.
    Set pFoundFiles = New Collection
    ' and the search criterions.
    pDirectoryPath = ""
    pFileNameFilter = ""
End Sub

' Launch the search and return the number of occurrences.
Public Function Execute() As Long
    'Lance la recherche
    doSearch

    Execute = pFoundFiles.Count
End Function

' Do the nasty work here.
Private Sub doSearch()
    Dim directoryPath As String
    Dim currentFile As String
    Dim filter As String

    directoryPath = pDirectoryPath
    If InStr(Len(pDirectoryPath), pDirectoryPath, "\") = 0 Then
        directoryPath = directoryPath & "\"
    End If

    ' If no directory is specified, abort the search.
    If Len(directoryPath) = 0 Then
        Exit Sub
    End If

    ' Check that directoryPath is a valid directory path.
    ' http://stackoverflow.com/questions/15480389/excel-vba-check-if-directory-exists-error
    If Dir(directoryPath, vbDirectory) = "" Then
        Debug.Print "Directory " & directoryPath & " does not exists"
        Exit Sub
    Else
        If (GetAttr(directoryPath) And vbDirectory) <> vbDirectory Then
            Debug.Print directoryPath & " is not a directory"
            Exit Sub
        End If
    End If

    ' We rely on the Dir() function for the search.
    ' cf https://msdn.microsoft.com/fr-fr/library/dk008ty4(v=vs.90).aspx

    ' Create the filter used with the Dir() function.
    filter = directoryPath

    If Len(pFileNameFilter) > 0 Then
        ' Add the file name filter.
        filter = filter & "*" & pFileNameFilter & "*"
    End If

    ' Start to search.
    currentFile = Dir(filter)
    Do While currentFile <> ""
        ' Use bitwise comparison to make sure currentFile is not a directory.
        If (GetAttr(directoryPath & currentFile) And vbDirectory) <> vbDirectory Then
            ' Add the entry to the list of found files.
            pFoundFiles.Add directoryPath & currentFile
        End If
        ' Get next entry.
        currentFile = Dir()
    Loop
End Sub

请建议如何解决！

Answer 1

我必须回答你在这里给我的评论问题。这可能无法解决您的问题，但它可能会帮助您找到它，特别是如果错误来自您在@dbmitch建议的另一个函数中设置pixpaths = nothing。

你可以像在pixpath中一样引用Image_Set中的.fileFiles，这个集合由.Execute函数中的doSearch子填充，所以下面的代码应该是一样的。此外，除非您在另一个模块中使用您的参数，否则您可能需要考虑将它们设置为私有，就像我在这里做的那样。

Private pix_path As String
Private pixnum As Integer
Private fs As YtoFileSearch

Public Sub Image_set()
    pix_path = "C:\Images"
    Set fs = New YtoFileSearch

    With fs
        .NewSearch
        .LookIn = pix_path
        .fileName = "*.jpg"

        If fs.Execute() > 0 Then
            'load first pix
            Forms!Fr_Main.imgPixHolder.Picture = .FoundFiles(1)
            pixnum = 1
        Else
            MsgBox "No files found!"
            DoCmd.OpenForm "Fr_Sketchpad"    ' If no images found in folder the set image from another form 'Sketchpad' image control
            Forms!Fr_Sketchpad.Visible = False
            Forms!Fr_Main!imgPixHolder.Picture = "" 
            'Forms!Fr_Sketchpad!Img_Std.Picture   Was getting another error here so commented this
            pixnum = 0
        End If
    End With
End Sub

Public Sub Image_loop()
    With fs
        If pixnum = .FoundFiles.Count Then
            pixnum = 1
        ElseIf pixnum <> 0 Then
            pixnum = pixnum + 1
            Forms!Fr_Main!imgPixHolder.Picture = .FoundFiles(pixnum)
        End If
    End With
End Sub

从文件夹中的pics循环播放图像幻灯片时出错

1 个答案: