Problem: Retrieving pictures from a folder to resize and crop
I take pictures and download to my laptop. I then select 1 by one to resize and crop. I recorded a macro to resize and crop but can only do 1 at a time. I want to run a batch file that selects each picture and runs he resize and crop macro. I won't know the file names in advance since they will always be changing but will always be in the same folder.
I need help in figuring out how to writhe batch file.
Thank you.
-Don-
The general way of processing all files of a certain type is a folder is ...
Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(" ........ " ) ' -- put the folder name between the quotes (or get its value from a textbox) 'Process all PNG files in that folder (change png to jpg or tif if appropriate) For Each objFile In objFolder.Files If LCase(Right(objFile.Name, 4)) = ".png" Then
do_some_code(objFile.Name) ' calls your code and passes the filename
End If
Next objFileEnd Sub
'Then you must isolate the important steps from your recorded macro and insert it in here ...
sub do_some_code(fileName)
'......... insert code to process your file -- you must delete the name of the file you recorded *and* its quotes, and replace it with the word fileName *without* adding the quotes back.
end sub
- - -
If in doubt, post the code of the macro you recorded and we'll try to sort you out.
Sub MULTIPLE_SLOTS_2() ' Recorded 9/24/2014 Dim impopt As StructImportOptions Set impopt = CreateStructImportOptions impopt.Mode = cdrImportFull Dim impflt As ImportFilter Set impflt = ActiveLayer.ImportEx("C:\Users\Don\Documents\Laser Etching\Camera\July 25 2014\101MSDCF\DSC05127.JPG", cdrJPEG, impopt) impflt.Finish Dim s1 As Shape Set s1 = ActiveShape s1.Move 1.532161, -12.333902 Dim grp1 As ShapeRange Set grp1 = s1.UngroupEx Windows.FindWindow("C:\Users\Don\Documents\Laser Etching\Human Tags\Camera Project\Location Template 8 Pack.cdr").ActiveView.ToFitAllObjects Dim crop1 As ShapeRange Set crop1 = grp1.CustomCommand("Crop", "CropRectArea", 2.76002, -11.546594, 21.01302, 8.774406) ActiveDocument.ReferencePoint = cdrCenter crop1.SetSize 1.13, 20.321 crop1.SetSize 1.13, 1.258 crop1.SetPosition 1.094, -1.386094 crop1.SetPosition 1.094, 10.5 Set impopt = CreateStructImportOptions impopt.Mode = cdrImportFull Set impflt = ActiveLayer.ImportEx("C:\Users\Don\Documents\Laser Etching\Camera\July 25 2014\101MSDCF\DSC05137.JPG", cdrJPEG, impopt) impflt.Finish Dim s2 As Shape Set s2 = ActiveShape s2.Move -9.06002, -12.519197 Dim grp2 As ShapeRange Set grp2 = s2.UngroupEx grp2.Rotate 270# Windows.FindWindow("C:\Users\Don\Documents\Laser Etching\Human Tags\Camera Project\Location Template 8 Pack.cdr").ActiveView.ToFitAllObjects Dim crop2 As ShapeRange Set crop2 = grp2.CustomCommand("Crop", "CropRectArea", -9.380343, -13.456791, 8.872657, 6.864209) crop2.SetSize 1.13, 20.321 crop2.SetSize 1.13, 1.258 crop2.SetPosition 2.494, -3.296291 crop2.SetPosition 2.494, 10.5End Sub
a) The width and height of the template page
----> 18"W x 12"H
b) The layout -- eg 2 rows vertically and 4 columns horizontally
----> 1 row of 8
c) The x and y position of the bottom left corner of the first crop frame -- measured on the template
--- > Pic 1: X= 1.094 Y= 10.5 Pic 2: X= 2.494 Y= 10.5 Pic 3: X= 3.894 Y= 10.5
Pic: 4: X= 5.294 Y= 10.5 Pic 5: X= 6.694 Y= 10.5 Pic 6: X= 8.094 Y=:10.5
Pic 7: X: 9.494 Y= 10.5 Pic 8: X= 10.894 Y=10.5
d) The width and height of the crop -- which seems to be 1.13 wide and 1.258 high.as deduced above
-------> Correct.
e) The horizontal distance from one frame to the next -- which seems to be 1.4 as deduced above.
-----> Correct
f) The vertical distance from one row to the next
------> Just do the 1 row of 8
g) when placed correctly, the position of the bottom left of the photo relative to its crop frame
----> The frame is a rectangle of 1.13"W x 1.969H
------->The picture from the top of the frame is a distance of 0.313"
-------> The picture from the bottom of the frame is a distance of 0.398"
h) the width and height of the photo.
------> The initial photo is 42.667" x 32.0" when opened in Corel. We use the cropped area in the center.
There is suppose to be a rotate of 270 degrees on all pictures. The pictures are taken landscape with the top of the picture at the left.
OK, most of that makes sense. But to double check the positioning ...
The imported photo is landscape, and is then rotated 270 degrees. Then scaled to a height of 2.68 ( 0.313 above + 1.969 frame + 0.398 below) and centre it horizontally in the frame ... ?
[Edit: see next message]
Sorry, re-read the instructions and now think that 1.969 is the height of the scaled image, with the other dimensions being subtracted from it.
So, we have something like this ...
1.969 is the height of the frame. Basically each one of the rectangles that the scaled down pictures will fit into.
Underneath the picture there is space for me to manually enter a name.
I will try again to attach pictures. Maybe use a smaller file size this time.
Again, I really appreciate your help.
If you are uploading an image (jpg, png etc) you can do it on the media icon in the edit box ...
It should cope with typical screen captures or images of up to about 680 pixels wide. Above that it will be scaled down for display, but we can still get the full image by double clicking on it.
If you want to upload a CDR file you can do that on the options tab when replying. But there is a 256Kb limit in the forum, which generally means you must use low resolution placeholders for large bitmaps and save without colour profile. Or you can put the file on a public server such as dropbox and post a link to it here.
The CDR file should be attached
A picture is worth a thousand words.
I think I have this almost ready to try ... I'm just tidying up a few things so I stand a chance of explaining it.
OK, Let's try ... I've resaved your CDR file with the test macro in it. It should pop up a form when you open the CDR file.
I've set the source path as C:\Users\Don\Documents\Laser Etching\Ready but you can edit that if needed.
If you have at least 8 JPG files in that folder, the macro should crop them and place them, then display a Done message. You probably want to do something instead of displaying Done, but that should work for testing.
To explain how the macro works ...
Dim SourceFolder As String, SourceType As String, CDRtype As cdrFilterDim resizeHeight As DoubleDim cropWidth As Double, bottomCrop As Double, topCrop As DoubleDim firstX As Double, firstY As Double, stepX As Double
The above declares the variables I am going to use for all the layout parameters.
When the button is clicked, we process the code ... I'm starting by setting values into those variables ...
Private Sub CommandButton1_Click()
'Preset the constants for easy editing (dimensions are in inches) SourceFolder = TextBox1.Value SourceType = ".jpg" 'Include the dot, use lower case CDRtype = cdrJPG 'without quotes -- must be correct CDRfilter for file type resizeHeight = 1.969 cropWidth = 1.13 bottomCrop = 0.398 topCrop = 1.969 - 0.313 firstX = 0.529 firstY = 9.866 stepX = 1.4
And then we get to importing the files. Its the procedure I described a few posts back, but modified so that we count the imported files, so we know which frame to put it in later ...
Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer 'Used to count the frame number i = 0 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(SourceFolder) 'Process all matching files in that folder (choose SourceType as above) For Each objFile In objFolder.Files If LCase(Right(objFile.Name, 4)) = SourceType Then i = i + 1 setInFrame objFile.Path, i ' processes the individual photo ActiveWindow.Refresh End If If i = 8 Then 'the page is full Exit For End If Next objFile
The above code only finds the filenames. You'll see the line setInFrame in the middle -- it calls a subroutine which performs the main import and cropping action -- we'll cover that later
At the end we check if we have reached the 8th file, to know when to stop. For the moment we will just pop up a message:
MsgBox "It's done"End Sub
In the button click code, we determined the filePath and counted the frameNumber -- which we pass to the subroutine ...
Sub setInFrame(filePath As String, frameNumber As Integer) Dim impflt As ImportFilter Dim posX As Double, posY As Double
Using code similar to the recorded macro we import the stated file, and rotate it ...
Set impflt = ActiveLayer.ImportEx(filePath, CDRtype) 'Import the file impflt.Finish Dim s1 As Shape Set s1 = ActiveShape s1.Rotate 270 'And rotate it
It will not import at the correct size for the frame, so we scale it ...
ActiveDocument.ReferencePoint = cdrCenter 'Make it correct height s1.Stretch resizeHeight / (s1.TopY - s1.BottomY)
To make the cropping easier, I'm temporarily moving the image to the bottom left of the page. That is not necessary, but it makes the crop calculations clearer.
s1.LeftX = 0 'Temporarily move to page origin to simplify crop calculation s1.BottomY = 0
Now to do the crop ...
Dim crop1 As ShapeRange 'Perform the crop Dim cropLeftX As Double, cropRightX As Double cropLeftX = (s1.RightX - cropWidth) / 2 cropRightX = cropLeftX + cropWidth Set crop1 = s1.CustomCommand("Crop", "CropRectArea", cropLeftX, bottomCrop, cropRightX, topCrop)
This is derived from your recorded macro, but with the numbers replaced by variables so that they can be more easily edited if necessary (in that section at the top of the code).
crop1.LeftX = firstX + (frameNumber - 1) * stepX 'move crop to its frame crop1.BottomY = firstY crop1.OrderToBack 'behind frame (in case it matters, delete if not required)
The image is now cropped, but it is still in the bottom left corner of the page. So this is the bit where we use the frameNumber to calculate where to move the cropped image ...
End Sub
That's an explanation of what should be happening, but mainly for information because its all in the macro in the resaved file ready for testing.
Thanks for all of this.
I am not doing something right. I created the ready file and put .jpg pictures in it.
I saved the location.....,cdr file you have at to p of the post. When in Corel I open that file and I just get an 8.5x11" blank worksheet.
You probably need to go to tools > options > workspace > VBA and make sure Delay Load VBA is off.
You should then see a popup message each time you open the file, asking to confirm that you want to run macros. The macro form will then be shown.