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
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.
Thanks. I turned it off. Now when I select Location%20Template%208%20Pack%20Update.cdr
nothing happens. It does not open.
That is very weird. I retested it on my laptop and it works there too.
My steps:
- open coreldraw
- file
-open
-selected Location%20Template%208%20Pack%20Update
It then just sits there in the directory. Waited 10 minutes