注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

徐彩刚的博客

我的站:MathCai.Com

 
 
 

日志

 
 

【转载】开始研究powerpoint的vba啦~~  

2012-08-26 17:12:33|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
开始研究powerpoint的vba啦~~
 
打算用powerpoint作为主要讲课手段,让俺给她做一个记分用的系统,就是分几个大组,给每个组加小星星什么的。。这个简单,就是vb的语法都忘光光,powerpoint的vba帮助也都没有装。。。好在找到一个不错的e文的vba网站,学了不少东东,大体搞出来了。。。回头改改。。。
'
Dim group(9) As Integer
Dim stars(9, 10) As Integer
'
Private Sub substar(a_idx As Integer)
    If UBound(group) >= a_idx Then
        Debug.Print CStr(a_idx) + "组现在有星星" + CStr(group(a_idx)) + " substract ----- "
        
        sName = "star" + CStr(a_idx) + "N" + CStr(group(a_idx))
        
        Debug.Print "-----" + sName
        
        If group(a_idx) > 0 Then
            ActivePresentation.Slides("showmark").Shapes(sName).Delete
            group(a_idx) = group(a_idx) - 1
        Else
            MsgBox "没有星星啦~"
        End If
            
        ActivePresentation.Slides("showmark").Shapes("mark" + CStr(a_idx)).TextFrame.TextRange.Text = CStr(group(a_idx))
    Else
        MsgBox "wrong message , shouldn't prompt this"
    End If
    
End Sub
Private Sub addstar(a_idx As Integer)
    If UBound(group) >= a_idx Then
        Debug.Print CStr(a_idx) + "组现在有星星" + CStr(group(a_idx)) + " add ----- "
        With ActivePresentation.Slides("showmark").Shapes("star").Duplicate
            group(a_idx) = group(a_idx) + 1
            .Name = "star" + CStr(a_idx) + "N" + CStr(group(a_idx))
            
            Debug.Print "-----" + .Name
                        
            
            If group(a_idx) > 15 Then ' 第二行 先定位,回头通过变量分配
                .Top = 140
                .Left = 10 + 30
            ElseIf group(a_idx) > 10 Then
                .Top = 140
                .Left = 10 + (group(a_idx) - 10) * 30
            ElseIf group(a_idx) > 5 Then
                .Top = 110
                .Left = 10 + (group(a_idx) - 5) * 30
            Else
                .Top = 80
                .Left = 10 + group(a_idx) * 30
            End If
            
            ActivePresentation.Slides("showmark").Shapes("mark" + CStr(a_idx)).TextFrame.TextRange.Text = CStr(group(a_idx))
            
            
        End With
    Else
        MsgBox "wrong message , shouldn't prompt this"
    End If
    
End Sub
----------------------
Private Sub cbadd1_Click()
    '
    For i = 1 To 1
        addstar (1)
    Next
    '
End Sub
Private Sub cbreset_Click()
    If MsgBox("确定要重新积分么?", vbOKCancel, "注意") = vbCancel Then
        Exit Sub
    End If
    
    For i = 1 To 9
        k = group(i)
        If k < 10 Then k = 30
        
        group(i) = 0
        For j = 1 To k
            On Error Resume Next
            odel = "star" + CStr(i) + "N" + CStr(j)
            Debug.Print "delete -- " + odel
            ActivePresentation.Slides("showmark").Shapes(odel).Delete
        Next
    Next
    
    ActivePresentation.Slides("showmark").Shapes("mark" + CStr(1)).TextFrame.TextRange.Text = "0"
    
End Sub
Private Sub cbsub1_Click()
    substar (1)
End Sub
  评论这张
 
阅读(42)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018