☰

用于裁剪网站的宏并将其粘贴到 powerpoint

tag-icon • tag-icon macros microsoft-powerpoint
用于裁剪网站的宏并将其粘贴到 powerpoint

我正在尝试制作用于裁剪网站的宏并使用 tinytask 将其粘贴到 powerpoint，但失败了

  1. 登录到网站。
  2. 裁剪页面。（任何工具，例如截图工具）。
  3. 将其粘贴到 powerpoint 幻灯片中。
  4. 调整图像大小。

我需要从网站上裁剪很多东西并粘贴到 powerpoint 中。

例如：1）我登录超级用户网站

2）裁剪网站 点击这里

3）将其粘贴到 powerpoint 中 点击这里

4）调整大小

答案1

这不是一个可行的操作。

VBA可以调用系统的截屏工具，但是我们无法在网页中控制截屏工具并粘贴到ppt中。

答案2

虽然从 VBA 执行整个操作可能不可行，但类似这样的操作可以消除大部分繁琐的工作。您可以手动制作屏幕截图，然后调用宏将新幻灯片添加到当前演示文稿中，粘贴屏幕截图，设置其格式，添加标题等等：

Option Explicit

' Edit these as required:
Const lLayoutType As Long = 6   ' 6=TitleOnly, 7=Blank
Const lFontSize As Long = 16    ' Font size of slide title, if any
Const sngCropTop As Single = 142

Sub PasteMap()
' Assumes map has been Alt+PrtScreen'ed from a fullscreen window in Chrome
' from Google Maps

    Dim oSl As Slide
    Dim oSh As Shape
    Dim sTemp As String
    
    sTemp = "Type title here"
    
    With ActivePresentation
        ' add a new slide
        Set oSl = .Slides.AddSlide(.Slides.Count + 1, .Designs(1).SlideMaster.CustomLayouts(lLayoutType))
        
        ' paste in the screenshot
        Set oSh = oSl.Shapes.Paste(1)
        
        ' format the pasted screenshot:
        With oSh
            ' prevent it from being distorted by size changes
            .LockAspectRatio = True
            
            ' set it to the width of the slide
            .Width = ActivePresentation.PageSetup.SlideWidth
            
            ' crop off the top by a pre-determined amount (see beginning of code)
            .PictureFormat.CropTop = sngCropTop
            
            ' move it to the left of the slide
            .Left = 0
            
            ' position it appropriately from top of slide
            .Top = ActivePresentation.PageSetup.SlideHeight - .Height
            
        End With
        
        ' get a title for the map, set and position the title
        On Error Resume Next    ' won't work if no title in the layout!
        Set oSh = oSl.Shapes(1) ' the title
        oSh.Top = 5
        oSh.TextFrame.VerticalAnchor = msoAnchorTop
        With oSh.TextFrame.TextRange
            .Font.Size = lFontSize
            sTemp = InputBox("Page title:", "Page title", sTemp)
            If Len(sTemp) > 0 Then
                .Text = sTemp
            End If
        End With
        
    End With
    
End Sub

相关内容