我的VBA自定义函数研习收获

liuxi001

向老师学习~

WYS67

weiyingde 发表于 2019-4-17 22:18
再发一同样是笔画的，亦为他人成果，特此说明。
Function 笔画1(Hz$) As Integer
'URL = "http://www.hyd ...

感谢老师分享

weiyingde

获取根目录下所有指定类型文件的随机文件名。
参数说明如下：
1、aPth为初始路径，可为根目录；
2、Lxg为获取文件的指定类型，
可为“ysp”-音视频；“yp”-音频；“sp”-视频；“wb”-文本；“bg”-表格；“tp”-图片等六类。
3、Opt为1和2,。1是短文件名；2为长文件名。

Public Function 随机文件(aPth As String, Lxg As String, Optional Opt As Variant)
Dim arr(), file() As String
Dim i, k, x
sr1 = ".mp3.wma.wav.mid.ogg.ape.acc.mp4.mp5.wkv.avi.wmv.flv.f4v.rm.rmvb.rmv.dat.asf.mov.vob.3gp.ts.swf.tp.ifo.nsv.tta.as3."
sr2 = ".mp3.wma.wav.mid.ogg.ape.acc."
sr3 = ".mp4.mp5.wkv.avi.wmv.flv.f4v.rm.rmvb.rmv.dat.asf.mov.vob.3gp.ts.swf.tp.ifo.nsv.tta.as3."
sr4 = ".txt.doc.docx.docm.pdf.wps."
sr5 = ".xls.xlsx.xlsm."
sr6 = ".TIFF.png.SWF.jpeg.tif"
Select Case Lxg
       Case "ysp": sr = sr1
       Case "yp": sr = sr2
       Case "sp": sr = sr3
       Case "wb": sr = sr4
       Case "bg": sr = sr5
       Case "tp": sr = sr6
End Select



On Error Resume Next
fd = aPth
x = 1: i = 1: k = 1
ReDim file(1 To i)
file(1) = fd

Do Until i > k
    f = Dir(file(i), vbDirectory)
        Do Until f = ""
            If InStr(f, ".") = 0 Then
                k = k + 1
                ReDim Preserve file(1 To k)
                file(k) = file(i) & f & "\"
            End If
            f = Dir
        Loop
    i = i + 1
Loop

For i = 1 To k
    f = Dir(file(i) & "*.*")
      Do Until f = ""
        If InStr(sr, Split(f, ".")(UBound(Split(f, ".")))) > 0 Then
          n = n + 1
          ReDim Preserve arr(1 To n)
          Select Case Opt
                 Case 1: arr(n) = file(i) & f '不带后缀的文件名
                 Case 2: arr(n) = Split(f, ".")(0)  '带路径、带后缀的文件名，即fullname
                ' arr(n, 2) = IIf(InStr(s2, Split(f, ".")(UBound(Split(f, ".")))) > 0, "音频", "视频")
          End Select
        End If
       x = x + 1
       f = Dir
     Loop
Next
    随机文件 = arr(Int(Rnd * UBound(arr)) + 1)
End Function

weiyingde

WYS67 发表于 2019-10-2 17:35
感谢老师分享

不谢，谢谢赐花。一起学习，共同进步。

YZC51

weiyingde 发表于 2019-2-7 21:56
谢谢提醒，有空学习学习。给个链接好吗？

请参考
http://club.excelhome.net/thread-1279693-1-1.html

weiyingde

YZC51 发表于 2019-10-2 19:56
请参考
http://club.excelhome.net/thread-1279693-1-1.html

谢谢你的热心帮助，谢谢。

YZC51

老师好！不客气！

weiyingde

Public Function 返回文本(slddex As Integer)
‘返回幻灯片指定页面的文本，slddex 为幻灯片的页序。
Dim shp As Shape, isr As String, sr As String
Set sld = ActivePresentation.Slides(slddex)
    For Each shp In sld.Shapes
        If shp.Type = 14 Then
           With shp
              If .HasTextFrame Then
                 With .TextFrame
                     If .HasText Then
                        With .TextRange
                            isr = .Text
                        End With
                     End If
                 End With
              End If
            End With
         End If
         sr = sr & isr
         If Len(sr) = 0 Then Exit For
     Next
返回文本= sr

microyip

weiyingde 发表于 2018-2-23 21:53
Public Function GetSJmz(ByVal 姓氏 As String, ByVal 名字 As String, ByVal 性别 As String) '3.1随机函 ...

GetSJmz，姓名名字写这么多，用字典记录会更理想

microyip

weiyingde 发表于 2019-10-2 18:24
获取根目录下所有指定类型文件的随机文件名。
参数说明如下：
1、aPth为初始路径，可为根目录；

随机文件，很多类似sr1,sr2等使用数组，更容易便捷调用