52148957 发表于 2016-4-12 13:28:54

如何通过VBA代码手动顺序不重复抽取图片？

在同一文件夹（文件夹位置可以任意路径）下有48张图片，命名从1.jpg到48.jpg，请教如何修改下面的VBA代码做到：
做到手动每点击指定一个按钮时，能按顺序抽取该文件夹的所有图片，在抽取完毕时，会弹出信息框提示“抽取完毕”，单击另一按钮，能清空前一个按钮的内容，以便重新抽取？
Option Explicit
Public I
Private Sub CommandButton1_Click()
On Error GoTo myerror
I = I + 1
Set CommandButton2.Picture = LoadPicture("E:图片" & I & ".jpg")
Exit Sub
myerror:
'MsgBox "已无图片", vbInformation + vbOKOnly, "提示"
CommandButton2.Picture = LoadPicture: I = 0
End Sub

qq32433525 发表于 2016-4-12 15:07:07

如果方便，添加附件，大家也容易操作些。

user_aibqdwwp 发表于 2016-4-12 15:22:31

这个问题值得关注，我也想达此目的，盼望高人

远在远方 发表于 2016-4-12 15:26:00

我做的是无顺序的，但不重复。即随机带相片点名。

kjiuh871 发表于 2016-4-12 15:42:21

可否分享？

user_xcafv 发表于 2016-4-12 15:53:10

Sub 点名2()
Dim vString As String
Dim Response
Dim xlApp As Object '定义存放引用对象的变量
If Sorted = False Then
Dim txtLine
Dim FileObj
Dim TextObj
Dim FilePath
FilePath = "班.txt"
Set FileObj = CreateObject("Scripting.FileSystemObject")
Set TextObj = FileObj.OpenTextFile(FilePath)
Do While Not TextObj.AtEndOfLine
txtLine = txtLine & "," & Trim(TextObj.ReadLine)
vString = Mid(txtLine, 2)
Loop
   sData = vString
    vWords = Split(sData, ",")
    Randomize
    Dim nCount As Long
    Dim nGetCnt As Long
    Dim nPos As Long
    Dim i As Long
    Dim bExist As Boolean
    Dim sWords As String
   
    nCount = UBound(vWords)
NameCount = nCount
    ReDim nWordsList(nCount) As Long
   
    For i = 0 To nCount
      nWordsList(i) = -1
    Next i
    Do While nGetCnt < nCount + 1
      nPos = Rnd * nCount
      bExist = False   
       For i = 0 To nCount
            If nPos = nWordsList(i) Then
                bExist = True
            End If
      Next i
      If Not bExist Then
            nWordsList(nGetCnt) = nPos
            nGetCnt = nGetCnt + 1
      End If
    Loop
    Sorted = True
End If
相片显示.Label1.Caption = vWords(nWordsList(CurrentNo))
相片显示.Image1.Picture = LoadPicture(相片显示.Label1.Caption & &quot;.jpg&quot;)
相片显示.Show
   If CurrentNo < NameCount Then
      CurrentNo = CurrentNo + 1
    Else
   MsgBox &quot;全部点到，重新点名！&quot;
      Sorted = False
   CurrentNo = 0
    NameCount = 0
    End If
End Sub

hjghjg 发表于 2016-4-12 16:30:28

我也是在别人的基础上修改的，花了很长时间。因我不懂VBA。不一定符合楼主的要求。

zhengtai 发表于 2016-4-12 16:55:14

演示一下：

zhq8008 发表于 2016-4-12 17:48:09

帮我解决下

dailiyuan 发表于 2016-4-12 18:11:03

过来学习一下下，，
页: [1]
查看完整版本: 如何通过VBA代码手动顺序不重复抽取图片？