Office学习社区 › 宏和VBA小程序开发 › 求修改很实用的VBA画笔

wxhbbc 发表于 2008-10-27 09:20:00

求修改很实用的VBA画笔

我很网上搜到了一个很实用的PPT VBA 画笔，比较方便使用。但是打开时有原作者名的对话框，不方便用于自己制作的各种PPT，求热心高手修改一下，修改成通用的PPT。

lichunfu19 发表于 2008-10-27 11:30:58

老大，加过密了，说明人家不让你修改，别侵权了。。。

user_bboxm 发表于 2008-10-27 11:32:11

其实自己在使用PPT的时候，
按Ctrl+P也能调出这个对话框啊！
原作者也只是利用vba调出这个画笔工具！
根本没有必要去侵权啊！

kuni0327 发表于 2008-10-27 12:31:48

就是嘛哈，不主张注册哈，最好自己找楼主哈。呵呵，不过VBA的功能的确很强大哈。特别是在交互应用方面。

9836498162495 发表于 2008-10-27 12:32:21

我正在努力的学习VBA。
越来越发现，不用这个是不行了

460082723 发表于 2008-10-27 12:35:14

看都没看到过，虚心......

253544162 发表于 2008-10-27 13:41:47

Private Sub 絙腹1_Click()
Call 絙腹
End Sub
Private Sub 礶掸1_Click()
Call 礶掸
End Sub
Private Sub 倔??揽1_Click()
Call 倔??揽
End Sub
Private Sub 堵︹1_Click()
Call 堵︹
End Sub
Private Sub ?︹1_Click()
Call ?︹
End Sub
Private Sub ?︹1_Click()
Call ?︹
End Sub
Private Sub 厚︹1_Click()
Call 厚︹
End Sub
Private Sub 屡︹1_Click()
Call 屡︹
End Sub
Private Sub 獵屡︹1_Click()
Call 獵屡︹
End Sub
Private Sub 档?︹1_Click()
Call 档?︹
End Sub
Private Sub 独︹1_Click()
Call 独︹
End Sub
Private Sub η︹1_Click()
Call η︹
End Sub
Private Sub 挡?1_Click()
Call 挡?
End Sub
Sub 絙腹()
SlideShowWindows(Index:=1).View.PointerType = ppSlideShowPointerArrow
End Sub
Sub 倔??揽()
On Error GoTo 0
Select Case Val(Application.Version)
Case 5
SlideShowWindows(Index:=1).View.EraseDrawing
Case 7
SlideShowWindows(Index:=1).View.EraseDrawing
Case 8
SlideShowWindows(Index:=1).View.EraseDrawing
Case 9
SlideShowWindows(Index:=1).View.EraseDrawing
Case 10
SlideShowWindows(Index:=1).View.EraseDrawing
Case Else
SlideShowWindows(Index:=1).View.PointerType = ppSlideShowPointerEraser
End Select
End Sub
Sub 堵︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=0, Green:=0, Blue:=0)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub ?︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=255, Green:=255, Blue:=255)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub ?︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=255, Green:=0, Blue:=0)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub 厚︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=0, Green:=255, Blue:=0)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub 屡︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=0, Green:=0, Blue:=255)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub 獵屡︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=0, Green:=255, Blue:=255)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub 档?︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=255, Green:=0, Blue:=255)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub 独︹()
With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=255, Green:=255, Blue:=0)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub η︹()
    With SlideShowWindows(Index:=1).View
      .PointerColor.RGB = RGB(Red:=160, Green:=160, Blue:=160)
      .PointerType = ppSlideShowPointerPen
    End With
End Sub
Sub 挡?()
SlideShowWindows(Index:=1).View.Exit
End Sub

查看完整版本: 求修改很实用的VBA画笔