ms-access - 从文件夹中的图片循环播放图像幻灯片时出错
问题描述
我正在尝试通过循环遍历预定义文件夹中的所有图像来更改图像控件 .picture 属性来创建图像幻灯片
C:\图像
我正在使用的代码:
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
请指教如何解决!
解决方案
我必须在这里回答您对我提出的评论问题。这可能无法解决您的问题,但它可能会帮助您找到它,特别是如果错误来自您pixpaths = nothing
在 @dbmitch 建议的另一个函数中设置。
您可以像使用 pixpath 一样引用 Image_Set 中的 .FoundFiles,该集合由 .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
推荐阅读
- sql - Postgres SQL Case Join 在第一个案例匹配时不停止
- docker - Docker构建不工作-权限被拒绝
- python - 使用 python 请求上传时文件获取已更改
- kubernetes - 使用 Istio 跨 K8s 集群在内部路由加权流量
- reactjs - 如何在状态 React Native 中设置数组特定值
- c++ - 下载时 C++ 解密
- python - 将前导数字添加到 Dataframe 中的数字
- android - 解析本地数据存储,将对象值检索为 null
- conemu - 在 FAR 中使用 shift+enter 启动 exe 后新窗口中的小文本
- php - Laravel 模型关系