红包墙 / 拆红包 /抽奖系统V1.0

zylz9941

谢谢楼主的分享

hehex

非常好的代码，思路也非常棒。不知道为啥不让给花了

13102918s

下载下来，文件已损坏？能否重新发一下，

水和米

gaozengxun 发表于 2021-1-5 21:29
我们WPS打开总出错，不过太谢谢了，改天好好研究研究。

WPS2019打开正常

blackttea1

谢谢楼主的分享

gaozengxun

水和米 发表于 2021-1-6 19:07
WPS2019打开正常

我的就是WPS209，点击总弹出
C:\Users\Administrator\Documents\

dengxsh

重新生成红包时，建议增加判断，避免误操作！

Sub RE()  
    Application.ScreenUpdating = False
    '//判断是否存在红包或红包封面
    Dim shp As Object
    n = 0
    For Each shp In ActiveSheet.Shapes
        If shp.Name Like "Cover*" Or shp.Name Like "bottom*" Then
            n = n + 1
        End If
    Next
    '//如果存在红包或红包封面，则确认；否则，直接重新生成
    If n > 0 Then
        If MsgBox("您确定要重新生成红包吗？", vbYesNo) = vbYes Then
            GoTo 100
        Else
            End
        End If
    Else
        GoTo 100
    End If
100:
    Call del
    Call Shuaxin
    ......
End Sub

yjh_27

dengxsh 发表于 2021-1-7 09:19
重新生成红包时，建议增加判断，避免误操作！

Sub RE()  

尽量不要用 GOTO,代码改为
Dim shp As Object
    For Each shp In ActiveSheet.Shapes
        If shp.Name Like "Cover*" Or shp.Name Like "bottom*" Then
            '//如果存在红包或红包封面，则确认；否则，直接重新生成
            If MsgBox("您确定要重新生成红包吗？", vbYesNo) <> vbYes Then Exit Sub
            Exit For
        End If
    Next

    Call del

vvw123

这个和手机希沃助手结合，完美实现手机点红包得功能

aecn

vvw123 发表于 2021-2-8 07:46
这个和手机希沃助手结合，完美实现手机点红包得功能

希沃助手？
2.0 实现拆红包音效，“转硬币”动画、及转动圈数设置