Results 1 to 4 of 4

Compressing Pictures with Code

This is a discussion on Compressing Pictures with Code within the Excel Questions forums, part of the Question Forums category; I have searched high and low and I havent been able to get any VBA code which will compress pictures. ...

  1. #1
    Board Regular Grizlore's Avatar
    Join Date
    Aug 2006
    Location
    Rose of the Shires
    Posts
    241

    Smile Compressing Pictures with Code

    I have searched high and low and I havent been able to get any VBA code which will compress pictures.

    A lot of the posts over t'internet say that it will come in a future version. These post were years old... so is it here yet?

    Does anyone know the code to compress pictures in Excel 2007

    Recording a macro doesnt pickup the compression parts

    Any help would be appreciated


    Regards
    GriZlore


    Statistics are like a lamp-post to a drunken man - more for leaning on than illumination.

  2. #2
    Board Regular
    Join Date
    Feb 2003
    Location
    Luton, England.
    Posts
    8,113

    Default Re: Compressing Pictures with Code

    What do you mean by "compress". If you just want to change the size, change the height and width of the picture.
    Regards
    BrianB (using XL2003 & 2010)
    Most problems occur from starting at the wrong place.
    Use a cup of coffee to speed up all Windows processes.
    It is easy until you know how.
    **FORMATTED/COMMENTED CODE IS MORE LIKELY TO GET A REPLY

  3. #3
    Board Regular Grizlore's Avatar
    Join Date
    Aug 2006
    Location
    Rose of the Shires
    Posts
    241

    Default Re: Compressing Pictures with Code

    compress - Under Picture Tools, on the Format tab, in the Adjust group, click Compress Pictures.

    This action doesnt appear to be picked up when recording code in VBA
    GriZlore


    Statistics are like a lamp-post to a drunken man - more for leaning on than illumination.

  4. #4
    Board Regular
    Join Date
    May 2008
    Location
    Biddiston Toowoomba QLD AUS
    Posts
    173

    Unhappy Re: Compressing Pictures with Code

    Post is old so you have solved it fully by now ??? if not try

    Function FileThereThere%(Ff$, ft$, DeleteFileTo As Boolean)
    Dim ftt%, Fofso As Scripting.FileSystemObject
    'need scripting reference
    Set Fofso = CreateObject("Scripting.FileSystemObject")
    If Fofso.FileExists(Ff) Then ftt = 2
    If Fofso.FileExists(ft) Then
    If DeleteFileTo Then
    Fofso.DeleteFile (ft)
    Else
    ftt = ftt + 1
    End If
    End If
    FileThereThere = ftt
    '0 none 1, file to , 2 file from, 3 both
    ' 00 01 10 11
    Set Fofso = Nothing
    End Function

    Sub WiaResizeTry(Ff$, ft$, mw%, mh%, DeleteFileTo As Boolean)
    ' parmeters ff FileFrom ft Fileto mw min width mh min height
    'Delete file to to delete before copping or abandon copy

    'MsgBox Ff & " " & ft & " " & DeleteFileTo

    If FileThereThere(Ff, ft, DeleteFileTo) = 2 Then '
    Dim Img 'As ImageFile
    Dim IP 'As ImageProcess
    'needs wia in references does not move people tags ?
    Set Img = CreateObject("WIA.ImageFile")
    Set IP = CreateObject("WIA.ImageProcess")
    On Error GoTo skipit
    Img.LoadFile Ff$
    IP.Filters.Add IP.FilterInfos("Scale").FilterID
    IP.Filters(1).Properties("MaximumWidth") = mw
    IP.Filters(1).Properties("MaximumHeight") = mh
    Set Img = IP.Apply(Img)
    Img.SaveFile ft
    skipit:
    Set Img = Nothing
    Set IP = Nothing
    End If
    End Sub

    'You will then need to use something like exiftool to move people and their rectangles if you want WLPG beta type people faces

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com