Running a macro across a folder
Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.
Sub Orchardcopypaste()
Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)
Do While FName < ""
Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)
With CalendarBk.ActiveSheet
.Rows("1:3").Clear
.Shapes("Picture 75").Delete
Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25
.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With
FName = Dir()
Loop
End Sub
"AnneOlly" wrote:
Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?
"Joel" wrote:
I woork on it a little later. What is the differrence between the original
filename and the new filename?
"AnneOlly" wrote:
Thanks Joel, I don't think i was clear before describing the process:
User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients
There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.
Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?
Thanks again for your help
Anne
"Joel" wrote:
Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.
I start with a blank workbook so there is no need to delete the old picture
75.
Sub Orchardcopypaste()
ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")
For Each sht In CalendarBk.Sheets
Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"
.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")
.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub
"AnneOlly" wrote:
OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?
Thanks guys
Anne
Sub Orchardcopypaste()
ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete
Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select
Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub
|