About WPS宏

• ， 30 9 月 2018
• 作者 Bluedream
• 呆马

About WPS宏

应好友所需，这两天了解了下WPS宏。WPS只有企业版才能用开发工具，个人需安装VBA模块。明明整个VBA都是“借鉴”人家的，现在反而变成自己企业版的噱头，这一手很“TX“。

“WPS VBA”关键字能找到五花八门各种插件，概因WPS各版本所支持的VBA也是不同的，官方声明最新版支持到VBA7.1。他用的WPS2016，所以装了相同环境和”VBA for wps 2016″。装上后宏模块确实能用了，于是稍微了解后开始动手。

● 目的：他所在部门有时需打印大量条形码，需要调整大小并挨个排好布局才能打印，手动非常繁琐。

● 步骤：其实很简单，格式化所有单元格尺寸至所需大小，然后将条形码调整后放到单元格。

---

下为表格格式，横向排4格为一页，每格放条码一张，细列为剪裁区。表格制作这里就不表了吧。

然后是图片处理，呆马更简单。
先将图片宽高改为格子宽高-2，然后居中放四边各留1

        
Private Sub ChangeImg(ByRef Img As Shape, ByRef Site As Range)
    With Img
       .Rotation = 0                                        '旋转=0
       .Top = Site.Top + 1                             
       .Left = Site.Left + 1
       .LockAspectRatio = msoFalse        '取消宽高比锁定
       .Width = Site.Width - 2                     
       .Height = Site.Height - 2
    End With
End Sub

那么比如第X张图片该放入哪个表格呢？计算一下。由第几张图片算出单元格的行列号

Private Function GetSite(ByVal Imgindex As Integer) As Range
    Dim lx As String                       ' B｜D｜F｜H
    Dim ly As Integer                     ' 1-29
    Dim lmod As Integer:lmod = Imgindex Mod 4
    ly = IIf(lm = 0, Imgindex \ 4, ImgIndex \ 4 + 1)
    Select Case lmod
        Case 0: lx = "H"
        Case 1: lx = "B"
        Case 2: lx = "D"
        Case 3: lx = "F"
    End Select
    Set GetSite = Range(lx & CStr(ly))
End Function

然后将所有图片循环即可。

Sub SetPic()
    Dim lCount As Integer：lCount = Sheet1.Shapes.Count        '表格里图形的数量
    If lCount > 2 Then                                                                       '大于2是因为表格里放了两个按键，也是图形
        Dim Index As Integer
        For Index = 3 To Sheet1.Shapes.Count                                    '所以要从3起
            ChangeImg Sheet1.Shapes(Index), GetSite(Index - 2)                          
            Range("K3").Value = CStr(Index - 2) & " | " & CStr(lCount - 2) & " ,请稍候..."     '处理过程中的进度显示
            Sleep 100: DoEvents
        Next
        Range("K3").Value = "图片处理已完成"
    Else
        MsgBox "表中无图片"
        Exit Sub
    End If
End Sub

到此主要目的已达成。

通电试机…呯！

各种折腾…

通电试机…呯！呯！

很简单的呆马，但测试过程中WPS频繁崩溃，体验度极差。起初怀疑是WPS跟VBA兼容性问题，我一直以为VBA模块都一样的。直至后来换了个版本的VBA模块，丝样顺滑一切问题解决…

好吧，怪不得宏只能企业版能用，或许企业版的VBA模块是金山深度定制过的吧，只能是这样了。

---

排版的问题解决了，然后发现插入条码又很不顺手，因为在插入栏输完条码它会自动跳至图片工具栏。。。每次都要点插入-图片-条码，很烦，像这样 ↓ ，尼玛都要跟不上了好吗

这个怎么解决呢？自动弹出条码插入框，30秒内如果检查到新图片插入就再次弹出，如果30内没新增就停止。呼出条码框用sendkeys发送WPS菜单快捷键即可。代码如下：

Sub AddPic()
    Range("B1").Select
    SendKeys "%N"    '插入
    Sleep 100
    SendKeys "SG"     '图库
    Sleep 100
    SendKeys "B"       '条形码
End Sub

因为VBA里没有Timer控件，所以要用API函数代替，30秒倒计时所用

Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long,ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long,ByVal nIDEvent As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub StartTimer()
    TimerSeconds = 1000
    TimerID = SetTimer(0&, 0&, TimerSeconds, AddressOf TimerProc)
End Sub

Private Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

Private Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Dim lCount As Integer:lCount = Sheet1.Shapes.Count
    If lCount > PicCount Then
        PicCount = lCount
        AddPicInTimer
    Else
        djs = djs - 1
        Range("K1").Value = djs
    End If
    If djs < 1 Then
        EndTimer
        Range("K1").Value = "自动弹出已关闭"
        djs = 30: PicCount = 0
    End If
End Sub

码完收工！奉上最后效果图，文末有完整代码。

带宏的WPS表格文件 → last.xlsm ← ,打开后在宏编辑器里即可看到源码。