|
'窗体中加入1个image1控件
Option Explicit
Dim flag As Boolean
Private Sub UserForm_Activate()
With Image1
.Top = 1
.Left = 1
.AutoSize = True
End With
loadpic
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
flag = True
End Sub
Function loadpic()
Dim filename(), n
If Not getfilename(filename, ThisWorkbook.Path, ".jpg") Then _
MsgBox "当前目录未发现jpg文件!": Exit Function
Do
n = n + 1
If n > UBound(filename) Then n = 1
With Image1
.Picture = loadpicture(filename(n))
Width = .Width + 1
Height = .Height + 1
End With
delay 1 '延时1s
If flag Then Exit Function
Loop
End Function
Function delay(dt)
Dim t
t = Timer
Do
If flag Then Exit Function
DoEvents
Loop Until Timer - t >= dt
End Function
Function getfilename(filename, pth, mark) As Boolean
Dim f, n
If Right(pth, 1) <> "\" Then pth = pth & "\"
f = Dir(pth & "*.*")
Do While Len(f) > 0
If LCase(Right(f, Len(mark))) = LCase(mark) Then
n = n + 1: ReDim Preserve filename(1 To n)
filename(n) = pth & f
End If
f = Dir
Loop
If n > 0 Then getfilename = True
End Function |
评分
-
1
查看全部评分
-
|