为了正常的体验网站,请在浏览器设置里面开启Javascript功能!

[应用]电脑演示存入幻灯片

2017-11-13 7页 doc 21KB 9阅读

用户头像

is_841159

暂无简介

举报
[应用]电脑演示存入幻灯片[应用]电脑演示存入幻灯片 电脑演示存入幻灯片 '共2个文件,以下文件存为ppt.vbp Type=Exe Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#. .\..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation Reference=*\G{91493440-5A91-11CF-8700-00AA0060263B}#2.8#0#. .\..\..\..\..\Program Files\Mic...
[应用]电脑演示存入幻灯片
[应用]电脑演示存入幻灯片 电脑演示存入幻灯片 '共2个文件,以下文件存为ppt.vbp Type=Exe Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#. .\..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation Reference=*\G{91493440-5A91-11CF-8700-00AA0060263B}#2.8#0#. .\..\..\..\..\Program Files\Microsoft Office\OFFICE11\msppt.olb#Microsoft PowerPoint 11.0 Object Library Form=ppt.frm Startup="ppt" HelpFile="" Command32="" Name="screentoppt" HelpContextID="0" CompatibleMode="0" MajorVer=1 MinorVer=0 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 VersionCompanyName="微软中国" CompilationType=0 OptimizationType=0 FavorPentiumPro(tm)=0 CodeViewDebugInfo=0 NoAliasing=0 BoundsCheck=0 OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1 [MS Transaction Server] AutoRefresh=1 '以下文件存为ppt.frm VERSION 5.00 Begin VB.Form ppt BorderStyle = 0 'None ClientHeight = 420 ClientLeft = 0 ClientTop = 0 ClientWidth = 4860 LinkTopic = "ppt" ScaleHeight = 420 ScaleWidth = 4860 ShowInTaskbar = 0 'False StartUpPosition = 3 '窗口缺省 Begin VB.CommandButton Command3 Caption = "图片输出到幻灯片" Height = 375 Left = 3120 TabIndex = 2 Top = 0 Width = 1695 End Begin VB.CommandButton Command2 Caption = "退出" Height = 375 Left = 1560 TabIndex = 1 Top = 0 Width = 1455 End Begin VB.CommandButton Command1 Caption = "截屏" Height = 375 Left = 0 TabIndex = 0 Top = 0 Width = 1455 End End Attribute VB_Name = "ppt" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long Private Declare Function GetTickCount Lib "kernel32" () As Long Private Sub Command1_Click() Dim i As Integer Me.Hide Me.AutoRedraw = True BitBlt Me.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy If Dir(App.Path & "\bmp", vbDirectory) = "" Then MkDir App.Path & "\bmp" End If For i = 1 To 9000 If Dir(App.Path & "\bmp\" & Format(i, "0000") & ".bmp") = "" Then sFile$ = App.Path & "\bmp\" & Format(i, "0000") & ".bmp" SavePicture Me.Image, sFile '保存 GoTo Lp1 End If Next Lp1: Me.Show End Sub Private Sub Command2_Click() End End Sub Private Sub Command3_Click() Dim MyApp As PowerPoint.Application Dim MyPres As PowerPoint.Presentation Dim MySlide As PowerPoint.Slide Set MyApp = New PowerPoint.Application MyApp.Visible = True MyApp.WindowState = PowerPoint.PpWindowState.ppWindowMinimized Set MyPres = MyApp.Presentations.Add Dim file1 As String For i = 1 To 9000 file1 = App.Path & "\bmp\" & Format(i, "0000") & ".bmp" If Dir(file1) <> "" Then Set MySlide = MyPres.Slides.Add(MyPres.Slides.Count + 1, PowerPoint.PpSlideLayout.ppLayoutTitleOnly) Call MySlide.Shapes.AddPicture(file1, False, True, 0, 0, 720, 540) DeleteFile file1 End If Next Dim ppt2 As String ppt2 = App.Path & "\" & GetTickCount & ".ppt" MyPres.SaveAs ppt2 Dim oSettings As PowerPoint.SlideShowSettings Set oSettings = MyPres.SlideShowSettings MyApp.Assistant.On = False MsgBox ppt2, vbOKOnly, "幻灯片存储完毕:" oSettings.Run End Sub Private Sub Form_Load() Me.Top = 0 Me.Left = Screen.Width / 2 SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3 '置顶 For i = 1 To 9000 file1 = App.Path & "\bmp\" & Format(i, "0000") & ".bmp" If Dir(file1) <> "" Then DeleteFile file1 End If Next End Sub
/
本文档为【[应用]电脑演示存入幻灯片】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。 本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。 网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。

历史搜索

    清空历史搜索