Consulting

Results 1 to 6 of 6

Thread: Resize JPG files to consistent size

  1. #1
    VBAX Regular
    Joined
    Apr 2008
    Posts
    97
    Location

    Red face Resize JPG files to consistent size

    OK here we go again with something that Excel was never designed to handle but here goes. My application inserts a picture when the user chooses a location to view from a designated folder. My problem is that these images are getting larger and larger as the reps get better cameras and it is becoming an issue on this end.

    My question is,
    Is there a way I can have excel resize JPG’s to a consistent size and overwrite the image? I would like to have this so when the user chooses the location it checks the size and if its too big then resize and overwrite it.

    Kind of like this.
    Insert c:\pictures\test.jpg
    If c:\pictures\test.jpg.size > 500k then resize and overwrite.

    I would even be open to a module that resized all JPG’s in the folder all at once to a specific size. I was searching a lot and found some examples of using the chart export functionality but was wondering if there is something in the script host object module that might help.

    If someone can point me in the right direction as to if it can be done and how to best approach it I can provide more information.

    I know, using a measuring tape to drive a nail

    Thanks again as always.

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I would use IRFanView for something like that. It has a batch option. You can also Shell() to it from VBA to do some tasks as well.

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I've found PixResizer to be a simple way to load folders worth of images and resize them

    Paul

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    When you say size, I am not sure if you mean file size or pixels. The solution would vary accordingly.

    If you have to do just one image, I would do something like what I did in this PerfectScript macro for WordPerfect: http://www.wpuniverse.com/vb/showthr...threadid=30690

    So you won't have to register to see the code at the site above, it is shown next. You can look at IRFanView's help for Command Line Switches for details on what you can do. The PerfectScript code is a bit similar to VBA so it should not be difficult to see what I did.
    //PasteOneGraphic.wcm by Kenneth Hobson, February 27, 2010
    
    //http://tiporama.com/tools/pixels_inches.html
    dpi=94    //Change to fit your screen.  Images wider than wPage should fit to magins.
    
    //imageFile="c:\myfiles\pics\onelanebridge.jpg"    //Used for testing.
    //Exit if macro was not passed an argument, graphic file's drive:\path\filename.ext.
    If (MacroArgs[0]=0)
        MessageBox(;"Macro Ending";"No image  drive:\path\filename.ext was passed.";IconStop!)
        Go(EndNow)
    EndIf
    imageFile=MacroArgs[1]
    
    //Exit if imageFile does not exist.
    If (Not(DoesFileExist(imageFile)))
        MessageBox(;"Image Does Not Exist";imageFile;IconStop!)
        Go(EndNow)
    EndIf
    
    //End if IrfanView is not installed.
    irfanview="C:\Program Files\IrfanView\i_view32.exe"
    irfanview="C:\Program Files (x86)\IrfanView\i_view32.exe"
    If (Not(DoesFileExist(irfanview)))
        MessageBox(;"IrfanView Not Found";irfanview;IconStop!)
        Go(EndNow)
    EndIf
    irfanviewq=""""+irfanview+""""+" "
    
    //Create a temporary TXT filename.
    tempdir=EnvVariableGet("temp")+"\"
    If (Not(DoesDirectoryExist(tempdir)))
        tempdir=EnvVariableGet("tmp")+"\"
    EndIf
    If (Not(DoesDirectoryExist(tempdir)))
        tempdir="c:\"
    EndIf
    tempFile=tempdir+"IrfanView.txt"
    
    //Delete tempFile if it exists.
    If (DoesFileExist(tempFile))
        DeleteFile(tempFile;NoPrompts!)
    EndIf    
    
    //Create a file to save resized image or image
    CopyGraphic=tempdir+"PasteOneGraphic.jpg"
    
    //Delete CopyGraphic if it exists
    If (DoesFileExist(CopyGraphic))
        DeleteFile(CopyGraphic;NoPrompts!)
    EndIf
    
    //Create the tempFile of image information in IrfanView.
    str=q(irfanview)+" "+q(imageFile)+" /info="+q(tempFile)+" /killmesoftly"
    AppExecute(str) 
    
    //Loop until tempFile is created.
    Repeat
        Wait(1)
    Until(DoesFileExist(tempFile))
    
    //Create an array with each line from tempFile.
    imageInfo[]=FileToArray(tempFile)
    
    //Find out the available wPage and hPage less the margins on the current page.
    wPage=ConvertType(?PaperWidth-?MarginRight-?MarginLeft;Number!)/1200
    hPage=ConvertType(?PaperLength-?MarginBottom-?MarginTop;Number!)/1200
    
    //Split imageInfo[] to get the parts needed for resizing computations.
    dimLine[]=StrParseList(imageInfo[6];" ")
    wPixel=dimLine[4]
    wInches=wPixel/dpi
    hPixel=dimLine[6]
    hInches=hPixel/dpi
    ratio=ConvertType(wPixel;Number!)/ConvertType(hPixel;Number!)
    If (ratio>=1)
        ls="long"
        Else ls="short"
    EndIf
    resize=" /resize_"+ls+"="
    If (wInches>wPage)
        wInches=wPage
        resize=resize+(wInches*dpi)+" /aspectratio /resample"
        else resize=""
    EndIf
    
    //Resize if needed and copy the graphic to the clipboard.
    str=q(irfanview)+" "+q(imageFile)+resize+" /clipcopy /convert="+CopyGraphic+" /transpcolor=(256,256,256) /killmesoftly"
    AppExecute(str) 
    
    //Paste after CopyGraphic is created.
    Repeat
        Wait(1)
    Until(DoesFileExist(CopyGraphic))
    EditPaste()
    
    //FileOpen(tempFile)    //Check image info.
    
    Go(EndNow)
    Function q(str)
        If (StrPos(str; """")>0)
            Return(str)
        EndIf
        qq=""""
        Return(qq+str+qq)
    EndFunc
    
    Names[]=FileToArray("c:\myfiles\wp\Names.txt")
    Function FileToArray(vFile)    //Read File into array and return array
        hFile=OpenFile (vFile; Read!; Compatibility!; AnsiText!)
        If (hFile=OpenFile.Error!)
            MessageBox (; "Open File Problem"; "Error processing password '^0' file!"; 
    IconStop!+HasParameters!; vFile)
            Quit
        EndIf
        Count=0
        Wait(1)        //Needed for fast computers.
        FilePosition(hFile; 0; FromBeginning!) 
        While (not FileIsEOF (hFile))
            Count = Count+1
            FileRead (hFile; x)
        EndWhile
        FilePosition(hFile; 0; FromBeginning!) 
        Declare TempArray[Count] 
        x=0
        While (not FileIsEOF (hFile))
            x=x+1
            FileRead (hFile; TempArray[x])
        EndWhile
        CloseFile (hFile)
        Return(TempArray[])
    EndFunc
    
    EndNow:

  5. #5
    I don't know if this suits your purpose but if you select for instance 4 cells wide (i.e. A11) the picture will fit to that width.

    Sub PictureInsertB()
        
        Dim pic As Picture
        Dim sPic As String
        Dim rPos As Range
        Dim ws As Worksheet
        Dim shp As Shape
        Dim fMod As Double
        
        Application.ScreenUpdating = False
        
        Set ws = ThisWorkbook.Worksheets("Sheet1")
        
        Set rPos = ws.Range(Selection.Address).Resize(75)
            
        sPic = Application.Dialogs(xlDialogInsertPicture).Show
        If TypeName(Selection) <> "Picture" Then Exit Sub
        Set pic = Selection
        
        fMod = IIf(rPos.Height / pic.Height < rPos.Width / pic.Width, rPos.Height / pic.Height, rPos.Width / pic.Width)
            
        With pic
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = pic.Width * fMod
            .Height = pic.Height * fMod
            .Left = rPos.Left '+ (rPos.Width / 2) - (.Width / 2)
            .Top = rPos.Top '+ (rPos.Height / 2) - (.Height / 2)
        End With
        
        Application.ScreenUpdating = True
    End Sub
    HTH
    John

  6. #6
    VBAX Regular
    Joined
    Apr 2008
    Posts
    97
    Location
    As always, I didn't add enough detail on the solution I was looking for. Oops.

    My application works fine to find the right picture from a designated folder, resize it, and place it in the sheet.

    The main problem is that the JPG's that the user stores in the folder are becoming very large files. These files get uploaded to the server through the app and I was looking for a way to automatically resize the actual JPG files to a smaller Pixel size (1024x768) and overwrite the JPG file in the users picture folder.

    I didn't really think that Excel could do this because it seems way outside its intended capability considering it is manipulating and editing graphic files but wanted to give it a shot.

    Our enviroment is so locked down that having an application installed to batch the users pictures probably wouldn't be an option. I can resize them here on the server but everytime the users update their pictures it would involve running the script on this end again.

    Hey, I knew I would hit the wall someday with what Excel could do. I am glad we will be moving to an enterprise solution in the next 18 months because what Excel is doing now is truly incredible.
    BTW, using Excel 2003 but could move to 2007 if needed.

    Thanks all for you help.

Posting Permissions

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