I don't feel confortable in going on with this development, because I seem that we miss a firm criteria to identify the files to manipulate.
For example we dont have a string in the filename to search, nor I am sure that the directory we will search in contains only files to manipulate, nor I know how many sheets the file contains and whether or not the sheet to rework has a specific name or index.
Therefore I shall adopt the following precautions:
-you are asked to create enough back up copies of your files, as I cannot guarantee that my macro is error free nor that it will behave as expected in your environment.
-after the macro starts, the user will select the directory to look in
-the macro will look for files in the format "*.xls*" (xls, xlsx, xslm, ....) and open them one by one
-if any of the worksheets is protected we shall skip that file
-if the file contains one picture (only one) then we shall go on:
--the picture will be replaced with a new one, in the same position of the removed one.
--the replacement picture will not be resized in any way, so it has to exist with the correct size
--the file will be saved with the same name BUT in a subdirectory named LOGONEW of the current path
--the file name will be saved in a log sheet along with few other information.
At the end of the process you will examine the new files and determine if they are to replace the old ones, and manually move them from the subdirectory to the main path, if this is necessary.
This is obtained (probably) by the following macro:
Code:
Sub ReBrand()
'see http://www.mrexcel.com/forum/excel-questions/834918-macro-visual-basic-applications-change-logo-multiple-workbooks-help.html
'by Anthony47
Dim PCount As Long, I As Long, Candid As Long, myPath As String, myFFile As String
Dim LogSh As Worksheet, LogoPos As String, newLogo As String, NextLogLine As Long
Dim mySk As Long, myRep As Long, myTim As Single
'
newLogo = "C:\Users\USER\Pictures\1971_002.jpg" '<<< The New Logo Path & Name
'
'Warning message:
rispo = MsgBox("You will be asked to select the Directory with the file to rebrand" & vbCrLf _
& "That Directory MUST HAVE an empty subdir named ""LOGONEW""" _
& vbCrLf & "Press Ok to continue, or Cancel to abort the Process", vbOKCancel)
If rispo <> vbOK Then Exit Sub
'Get the path of the files:
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox ("No any selection, procedure is aborted")
Exit Sub
End If
myPath = .SelectedItems.Item(1)
End With
'
'Ready to start:
myTim = Timer
Set LogSh = ThisWorkbook.Sheets(1) 'We will log the activities on this sheet
'
myFFile = Dir(myPath & "\*.xls*") 'get first file name
Application.EnableEvents = False
Do
PCount = 0
If myFFile = "" Then Exit Do 'Exit when non file
Workbooks.Open myPath & "\" & myFFile
'Log name of file:
NextLogLine = LogSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
LogSh.Cells(NextLogLine, 1) = myFFile
'Count how many pics:
For I = 1 To Worksheets.Count
LogSh.Cells(NextLogLine, 2).Offset(0, I) = Sheets(I).Name
If Sheets(I).Pictures.Count > 0 Then
PCount = PCount + Sheets(I).Pictures.Count
If Sheets(I).ProtectContents Then PCount = 999
'Log info on the sheets:
LogSh.Cells(NextLogLine, 2).Offset(0, I).Value = "*--" & PCount & "--*--" & Sheets(I).Name
Candid = I
End If
If PCount > 1 Then '>1, non need to scan more sheets
Exit For
End If
Next I
If PCount = 1 Then 'File is candidate for rebranding
Worksheets(Candid).Select
If UCase(Left(ActiveSheet.Pictures(1).Name, 7)) = "PICTURE" Then
'ok, rebrand:
ActiveSheet.Pictures(1).Select
LogoPos = Selection.TopLeftCell.Address
Selection.Delete
Range(LogoPos).Select
ActiveSheet.Pictures.Insert(newLogo).Select
Range("A1").Select
'Log result:
LogSh.Cells(NextLogLine, 2).Value = ">>>>>: " & LogoPos
myRep = myRep + 1
'Save in the new subdir:
ActiveWorkbook.SaveAs (myPath & "\LOGONEW\" & myFFile)
Else
'Log result:
LogSh.Cells(NextLogLine, 2).Value = "SKIPPED--" & PCount
mySk = mySk + 1
End If
Else
'log result:
LogSh.Cells(NextLogLine, 2).Value = "SKIPPED--" & PCount
mySk = mySk + 1
End If
Workbooks(myFFile).Close savechanges:=False 'Close
myFFile = Dir 'Next file
Loop
Application.EnableEvents = True
'
'Final message:
MsgBox ("Completed in (secs): " & Format(Timer - myTim, "0.00") & vbCrLf _
& "Replaced: " & myRep & vbCrLf & "Skipped: " & mySk)
End Sub
Start from an empty workbook, whose Sheets(1) will be used to log information on the file processed; press Alt-F11 to open the macro environment; Menu /Insert /Module; copy the code and past it into the frame at the right.
Personalize the line marked "<<<" with the full path and name of the new logo.
Return to the Excel sheet, save the workbook, then run the macro "ReBrand" (Alt-F8, select ReBrand from the list of available macros, press Run).
You will then be asked to select the directory where the files are located; the files will be open one by one and processed as I sayd before.
Sheet(1) of the file will be used to log what happen with the files; here it is an example of report
Code:
Paris_B40518.xlsx SKIPPED--2 *--2--*--Foglio1
SCR_emails.xlsx SKIPPED--0 Emittente_Gestore
SCR_Overview.xlsx >>>>>: $E$20 Mappa *--1--*--Overview
Tabelline.xlsm SKIPPED--999 *--999--*--Foglio1
First column is the name of the file
Second column is the result:
-skipped--2 means skipped because the file have at least 2 Pictures
-skipped--0 means that no Picture was found
-skipped--999 means that a sheet having Pictures is protected
->>>>>:$E$20 means that the file was "rebranded" and the new logo was set in cell E20 (TopLeft corner) of the sheet named Overview.
Third and subsequent columns contains the sheet name and the number of Pictures (if any); if the number of Pictures is higher than 1, subsequent sheets are not scanned
Don't forget backupping the data before running; I did some testing on a simple environment, and cannot guarantee that everithing will be ok.
Hope this is of some benefit...
