EXCEL中图片处理

Sub SetPicture()

    '缩小Image的尺寸

    Sheets(1).Shapes.SelectAll

    Selection.ShapeRange.PictureFormat.Contrast = 0.5

    Selection.ShapeRange.PictureFormat.Brightness = 0.5

    Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic

    Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse

    Selection.ShapeRange.Fill.Visible = msoFalse

    Selection.ShapeRange.Line.Visible = msoFalse

    Selection.ShapeRange.Rotation = 0#

    Selection.ShapeRange.PictureFormat.CropLeft = 0#

    Selection.ShapeRange.PictureFormat.CropRight = 0#

    Selection.ShapeRange.PictureFormat.CropTop = 0#

    Selection.ShapeRange.PictureFormat.CropBottom = 0#

    Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft

    Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft

    Selection.ShapeRange.IncrementTop -13.5

    

    Dim LastRow As Long

    Dim r As Long

    Dim num As Long

    Dim Name As String

    

    LastRow = ActiveSheet.UsedRange.Rows.Count

    LastRow = LastRow + ActiveSheet.UsedRange.Row - 1

    Application.ScreenUpdating = False

    

    For r = LastRow To 1 Step -1

        If (Cells(r, 2) = "明 细 帐") Then Rows(r).RowHeight = 35

    Next r

    

End Sub