Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
I found a small error
from With .Range("AW2").Select to With .Range("AW2") "Joel" wrote: 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
Joel, this is cool thank you so much.
I am getting an run-time error '438' on line 38 ..Close (Object doesn't support this property or method) Cheers Anne "Joel" wrote: I found a small error from With .Range("AW2").Select to With .Range("AW2") "Joel" wrote: 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
Hi Joel
Any luck with the error, or is it my inept VBA skills. Cheers Anne "AnneOlly" wrote: Joel, this is cool thank you so much. I am getting an run-time error '438' on line 38 .Close (Object doesn't support this property or method) Cheers Anne "Joel" wrote: I found a small error from With .Range("AW2").Select to With .Range("AW2") "Joel" wrote: 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
Hi AnneOlly,
Try the following minor adaptation of Joel's code. I have added variable delarations and made a minor syntax correction but I have not otherwise reviewwd thec code. '============ Public Sub Orchardcopypaste() Dim CalendarBk As Workbook Dim FindName As String Dim Fname As Variant Const sPic As String = _ "H:\My Documents\MyPictures\lincoln.jpg" Const sHeader As String = "Monthly Management Report" Folder = "C:\ORCHARD" FindName = "CalendarView*.xls" Fname = Dir(Folder & "\" & FindName) Do While Fname < "" Set CalendarBk = Workbooks.Open _ (Filename:=Folder & "\" & Fname) With CalendarBk With .ActiveSheet .Rows("1:3").Clear .Shapes("Picture 75").Delete Set newpict = .Pictures.Insert(sPic) .Range("AW2").FormulaR1C1 = sHeader With .Range("AW2") 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 End With .SaveAs Filename:=Folder & "\Orchard " & Fname .Close End With Fname = Dir() Loop End Sub '<<============ --- Regards. Norman "AnneOlly" wrote in message ... Hi Joel Any luck with the error, or is it my inept VBA skills. Cheers Anne "AnneOlly" wrote: Joel, this is cool thank you so much. I am getting an run-time error '438' on line 38 .Close (Object doesn't support this property or method) Cheers Anne "Joel" wrote: I found a small error from With .Range("AW2").Select to With .Range("AW2") "Joel" wrote: 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 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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
Hi all
I fixed the error on .Close and replaced with ActiveWorkbook.Close False, it seems to work. Yippeee Thanks guys for your help/skill/knowledge etc etc Anne "AnneOlly" wrote: Hi Joel Any luck with the error, or is it my inept VBA skills. Cheers Anne "AnneOlly" wrote: Joel, this is cool thank you so much. I am getting an run-time error '438' on line 38 .Close (Object doesn't support this property or method) Cheers Anne "Joel" wrote: I found a small error from With .Range("AW2").Select to With .Range("AW2") "Joel" wrote: 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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running a macro across a folder
You still may need to position and size the logo. Norman removed the 4
commented lines which you may need to add to get the size and position correct ' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft ' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft ' newpict.ShapeRange.IncrementLeft 209.25 ' newpict.ShapeRange.IncrementTop 8.25 Use the macro record option I specified in earlier posting and change the number in the code above with the number you delect in the recorded macro. "AnneOlly" wrote: Hi all I fixed the error on .Close and replaced with ActiveWorkbook.Close False, it seems to work. Yippeee Thanks guys for your help/skill/knowledge etc etc Anne "AnneOlly" wrote: Hi Joel Any luck with the error, or is it my inept VBA skills. Cheers Anne "AnneOlly" wrote: Joel, this is cool thank you so much. I am getting an run-time error '438' on line 38 .Close (Object doesn't support this property or method) Cheers Anne "Joel" wrote: I found a small error from With .Range("AW2").Select to With .Range("AW2") "Joel" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Report with macro losing links to a particular worksheet after running macro | Excel Programming | |||
disable user running macro from Tools Macro | Excel Discussion (Misc queries) | |||
Save file in a new folder, but create folder only if folder doesn't already exist? | Excel Programming | |||
Need syntax for RUNning a Word macro with an argument, called from an Excel macro | Excel Programming | |||
Launch Macro in Access via Macro running in Excel??? | Excel Programming |