PowerPoint macro : copy and resize to fit the width of a slide

macro ตัวนี้ช่วยประหยัดเวลาในการ copy รูปจำนวนมากใส่ใน PowerPoint เพราะมันจะช่วย paste และปรับขนาดรูปให้เต็มความกว้างของสไลด์โดยอัตโนมัติ

Sub paste_and_resize()
    ' วาง
    ActiveWindow.View.Paste
    ' คำนวณว่าต้องสเกลเท่าไร
    sc = ActivePresentation.SlideMaster.Width / ActiveWindow.Selection.ShapeRange.Width
    With ActiveWindow.Selection.ShapeRange
        ' ย่อ/ขยายขนาดให้เต็มความกว้างของสไลด์
        .ScaleWidth sc, msoFalse, msoScaleFromBottomRight
        .ScaleHeight sc, msoFalse, msoScaleFromBottomRight
        ' กำหนดตำแหน่งให้รูปชิดมุมบนซ้าย
        .Left = 0
        .Top = 0
    End With
End Sub

ปรับปรุงจากโค้ดที่แล้ว : ปรับขนาดไม่ให้ล้น

Sub paste_and_resize()
    ' paste image
    ActiveWindow.View.Paste
    ' find scaling ratio
    shapeRatio = ActiveWindow.Selection.ShapeRange.Width / ActiveWindow.Selection.ShapeRange.Height
    screenRatio = ActivePresentation.SlideMaster.Width / ActivePresentation.SlideMaster.Height
    If shapeRatio > screenRatio Then
        sc = ActivePresentation.SlideMaster.Width / ActiveWindow.Selection.ShapeRange.Width
    Else
        sc = ActivePresentation.SlideMaster.Height / ActiveWindow.Selection.ShapeRange.Height
    End If
    ' scale and move to top-left corner
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth sc, msoFalse, msoScaleFromBottomRight
        .ScaleHeight sc, msoFalse, msoScaleFromBottomRight
        .Left = 0
        .Top = 0
    End With
End Sub

เพิ่มการจัดรูปให้อยู่กึ่งกลางหน้าจอ

Sub paste_and_resize()
    '-----------------------------------------------------
    ' paste image
    '-----------------------------------------------------
    ActiveWindow.View.Paste
    
    '-----------------------------------------------------
    ' resize to fit width or height
    '-----------------------------------------------------
    ' screen dimension
    scrWidth = ActivePresentation.SlideMaster.Width
    scrHeight = ActivePresentation.SlideMaster.Height
    ' image dimension
    imgWidth = ActiveWindow.Selection.ShapeRange.Width
    imgHeight = ActiveWindow.Selection.ShapeRange.Height
    
    ' find scaling ratio
    imgRatio = imgWidth / imgHeight
    screenRatio = scrWidth / scrHeight
    If imgRatio > screenRatio Then
        ' fit width
        scl = scrWidth / imgWidth
    Else
        ' fit height
        scl = scrHeight / imgHeight
    End If
    ' scale and move to top-left corner
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth scl, msoFalse, msoScaleFromBottomRight
        .ScaleHeight scl, msoFalse, msoScaleFromBottomRight
    End With
    
    '-----------------------------------------------------
    ' move to center
    '-----------------------------------------------------
    newLeft = 0
    newTop = 0
    If imgRatio > screenRatio Then
        ' center height
        imgHeight = ActiveWindow.Selection.ShapeRange.Height
        newTop = (scrHeight - imgHeight) / 2
    Else
        ' center width
        imgWidth = ActiveWindow.Selection.ShapeRange.Width
        newLeft = (scrWidth - imgWidth) / 2
    End If
    ' move to center
    With ActiveWindow.Selection.ShapeRange
        .Left = newLeft
        .Top = newTop
    End With
End Sub
Advertisements

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s