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

tangqingfu

在同一文件夹（文件夹位置可以任意路径）下有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

该贴已经同步到 tangqingfu的微博

wjhere

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

weiyingde

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

chuhaiou

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

tangqingfu

chuhaiou 发表于 2016-2-15 19:22
我做的是无顺序的，但不重复。即随机带相片点名。

可否分享？

chuhaiou

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 & ".jpg")
相片显示.Show
   If CurrentNo < NameCount Then
      CurrentNo = CurrentNo + 1
    Else
     MsgBox "全部点到，重新点名！"
      Sorted = False
   CurrentNo = 0
    NameCount = 0
    End If
End Sub

chuhaiou

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

chuhaiou

演示一下：

chuhaiou

帮我解决下http://club.excelhome.net/forum-23-1.html

id00123

过来学习一下下，，