Jump to content
JohnyX

Replace excel images

Recommended Posts

JohnyX

Hello 


I have about 6000 excel files.

For each file, I have to replace an image located in A1:D2 range with another image from local storage. The image from the excel file is named "Picture 1".

I used WeaponX's (I hope I am not wrong) file search script and added my code. The script works fine but it crashes after processing about 150-200 files.

The script should replace the existing excel file image with another one from local storage and save all files to a new location keeping the directory structure. 

Can anyone help me fix it please? 

 

#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Icon=..\..\..\Downloads\Aha-Soft-Desktop-Halloween-Halloween.ico
#AutoIt3Wrapper_Outfile=IFCS x86.exe
#AutoIt3Wrapper_Outfile_x64=IFCS x64.exe
#AutoIt3Wrapper_Compile_Both=y
#AutoIt3Wrapper_UseX64=y
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#include <ButtonConstants.au3>
#include <EditConstants.au3>
#include <GUIConstantsEx.au3>
#include <GuiStatusBar.au3>
#include <StaticConstants.au3>
#include <WindowsConstants.au3>
#include <array.au3>
#include <Excel.au3>
#include <EditConstants.au3>
#include <GUIEdit.au3>
#include <ScrollBarConstants.au3>
HotKeySet("+!d", "FPause")
HotKeySet("+x", "Form1Close")
;$WS_EX_TOPMOST,
Opt("WinTitleMatchMode", 2)
Opt("GUIOnEventMode", 1)
Global $Paused, $counter = 0
#Region ### START Koda GUI section ### Form=
$Form1 = GUICreate("IFCS Update", 498, 431, 192, 124, -1, $WS_EX_TOPMOST)
GUISetBkColor(0xC0C0C0)
GUISetOnEvent($GUI_EVENT_CLOSE, "Form1Close")
$Group1 = GUICtrlCreateGroup("", 8, 40, 481, 201)
$Label1 = GUICtrlCreateLabel("Search in:", 24, 56, 92, 17)
$Input1 = GUICtrlCreateInput("C:\Users\john\Desktop\MPTEST", 120, 52, 353, 21)
$Label2 = GUICtrlCreateLabel("Left:", 24, 184, 47, 17)
$Labell = GUICtrlCreateLabel("Top:", 110, 184, 47, 17)
$Checkbox2 = GUICtrlCreateCheckbox("Delay", 24, 214, 129, 17)
$Input2 = GUICtrlCreateInput("5", 50, 181, 49, 21, BitOR($GUI_SS_DEFAULT_INPUT, $ES_UPPERCASE))
$Inputl = GUICtrlCreateInput("5", 140, 181, 49, 21, BitOR($GUI_SS_DEFAULT_INPUT, $ES_UPPERCASE))
$Label3 = GUICtrlCreateLabel("W:", 312, 186, 18, 17)
$Input3 = GUICtrlCreateInput("90", 336, 182, 49, 21, BitOR($GUI_SS_DEFAULT_INPUT, $ES_NUMBER))
$Label4 = GUICtrlCreateLabel("H:", 400, 186, 15, 17)
$Input4 = GUICtrlCreateInput("25", 424, 182, 49, 21, BitOR($GUI_SS_DEFAULT_INPUT, $ES_NUMBER))
$Label5 = GUICtrlCreateLabel("Insert image:", 24, 152, 86, 17)
$Input5 = GUICtrlCreateInput("C:\Users\john\Desktop\image.png", 120, 150, 353, 21)
$Label6 = GUICtrlCreateLabel("File type:", 24, 88, 66, 17)
$Input6 = GUICtrlCreateInput(".xls", 120, 88, 49, 21)
$Input7 = GUICtrlCreateInput(".xlsx", 192, 88, 49, 21)
$Input8 = GUICtrlCreateInput(".csv", 264, 88, 57, 21)
$Label8 = GUICtrlCreateLabel("If cell:", 24, 120, 64, 17)
$Input9 = GUICtrlCreateInput("J1", 120, 116, 73, 21)
$Label9 = GUICtrlCreateLabel("Contains:", 216, 120, 71, 17)
$Input10 = GUICtrlCreateInput("File to be changed", 296, 116, 177, 21)
$LabelDepth = GUICtrlCreateLabel("Save in:", 160, 216, 71, 17)
$radical = GUICtrlCreateLabel("Nr. of chars:", 380, 216, 71, 17)
$DirDepth = GUICtrlCreateInput("C:\Users\john\Desktop", 215, 212, 150, 21)
$radicalinput = GUICtrlCreateInput("34", 435, 212, 38, 21)
GUICtrlCreateGroup("", -99, -99, 1, 1)
$Label7 = GUICtrlCreateLabel("Excel file update Update", 112, 8, 257, 33)
GUICtrlSetFont(-1, 18, 800, 0, "MS Sans Serif")
GUICtrlSetColor(-1, 0x008000)
$Group3 = GUICtrlCreateGroup("", 8, 248, 153, 105)
$Checkbox1 = GUICtrlCreateCheckbox("Manual confirmation", 24, 272, 129, 17)
$Button1 = GUICtrlCreateButton("Start", 32, 308, 105, 25)
GUICtrlSetOnEvent(-1, "Button1Click")
GUICtrlCreateGroup("", -99, -99, 1, 1)
$StatusBar1 = _GUICtrlStatusBar_Create($Form1)
$StatusBar1 = _GUICtrlStatusBar_Create($Form1)
$Group2 = GUICtrlCreateGroup("Real-Time Tracking", 176, 248, 313, 105)
$Tracking = GUICtrlCreateEdit("", 184, 264, 297, 81, BitOR($ES_AUTOVSCROLL, $ES_WANTRETURN))
GUICtrlSetData(-1, "Tracking..." & @CRLF)
GUICtrlCreateGroup("", -99, -99, 1, 1)
$Label11 = GUICtrlCreateLabel("Shift-Alt-d = Pause / Continue", 22, 368, 300, Default)
GUICtrlSetFont(-1, 14, 800, 0, "Comic Sans MS")
GUICtrlSetColor(-1, 0x808080)

$Label13 = GUICtrlCreateLabel("Shift-x = Exit", 360, 370, 200, Default)
GUICtrlSetFont(-1, 14, 800, 0, "Comic Sans MS")
GUICtrlSetColor(-1, 0x808080)
GUISetState(@SW_SHOW)
#EndRegion ### END Koda GUI section ###

While 1
    Sleep(100)
WEnd


Func Button1Click()

    Local $folder = GUICtrlRead($Input1)
    $timestamp = TimerInit()

    RecursiveFileSearch($folder)
    MsgBox(0, "", (TimerDiff($timestamp) / 1000) & " seconds") ;0.0902s / 2090 files


EndFunc   ;==>Button1Click

Func Form1Close()
    Exit 0
EndFunc   ;==>Form1Close

Func RecursiveFileSearch($startDir, $depth = 0)

    ; Declaring variables
    Local $xls = GUICtrlRead($Input6)
    Local $xlsx = GUICtrlRead($Input7)
    Local $csv = GUICtrlRead($Input8)
    Local $cell = GUICtrlRead($Input9)
    Local $text = GUICtrlRead($Input10)
    Local $picture = GUICtrlRead($Input5)
    Local $cellimg = GUICtrlRead($Input2)
    Local $w = GUICtrlRead($Input3)
    Local $h = GUICtrlRead($Input4)
    Local $dir = GUICtrlRead($DirDepth)
    Local $Rad = GUICtrlRead($radicalinput)
    If $depth = 0 Then Global $RFSstring = ""
    $search = FileFindFirstFile($startDir & "\*.*")
    If @error Then Return

       $gg = 1
    While 1

            ToolTip('Script is "Running"', 0, 0, "", 1)
        $next = FileFindNextFile($search)
        If @error Then ExitLoop
        ;If folder, recurse
        If StringInStr(FileGetAttrib($startDir & "\" & $next), "D") Then
            RecursiveFileSearch($startDir & "\" & $next, $depth + 1)
         ; Check if file is excel compatible or shortcut
        ElseIf StringInStr($startDir & "\" & $next, $xls) Or StringInStr($startDir & "\" & $next, $xlsx) Or StringInStr($startDir & "\" & $next, $csv) Or StringInStr($startDir & "\" & $next, ".lnk") Then

            ;Open the file
            Local $oExcel = _Excel_Open()
            Local $sWorkbook = $startDir & "\" & $next
            ;MsgBox(Default,Default, $startDir & "\" & $next) --for debug
            Local $oWorkbook = _Excel_BookOpen($oExcel, $sWorkbook)
            ;If delay checkbox is checked, wait for window activation
            If GUICtrlRead($Checkbox2) = $GUI_CHECKED Then WinWaitActive("Microsoft Excel")
            ;Check if file is one of those we want to replace
            If _Excel_RangeRead($oWorkbook, Default, $cell) = $text Then
            ;Delete the existing image by sending VBA code to excel VBA editor, i could not find another way
                Send("!{F11}")
                Send("^g")
                WinActivate("Microsoft Visual Basic")
                Send('ActiveSheet.Shapes.Range(Array("Picture 1")).Delete')
                WinActivate("Microsoft Visual Basic")
                Send("{ENTER}")
                ; In case of an error in VBA editor, send ESC to clode the error
                Send("{ESC}")
                Send("{ESC}")
                WinActivate("Microsoft Visual Basic")
                ; Close VBA editor window
                Send("!q")
                ; Insert the new picture
                _Excel_PictureAdd($oWorkbook, Default, $picture, 5, 5, $w, $h)
                ; If we want manual confirmation, in case of an unwanted file, it will write a log file
                If GUICtrlRead($Checkbox1) = $GUI_CHECKED Then
                    $ret = MsgBox(4, Default, "Is it ok?")
                    If $ret == 6 Then

                    ElseIf $ret == 7 Then
                        FileWriteLine(@DesktopDir & "\RaportIFCSerror.txt", $startDir & "\" & $next)
                    EndIf
                 EndIf
                ; Because of compatibility mode we can not save the changes to the .xls file so we will save it to anothe location as a new file using _Excel_BookSaveAs() to a .xlsx file
               If StringRight($next, 4) = ".xls" Then
                  If Not FileExists($dir&"\"& StringMid($startDir, $Rad)) Then DirCreate($dir&"\"& StringMid($startDir, $Rad)) ; Create directory structure to the new location
                  _Excel_BookSaveAs($oWorkbook, $dir & "\" & StringMid($startDir, $Rad) &"\"& StringReplace($next, ".xls", ".xlsx"))

               EndIf
               If StringRight($next, 5) = ".xlsx" Then
                 ;MsgBox(Default, Default, $dir & "\" & StringMid($startDir, $Rad) & "\" & $next) --for debug
                  If Not FileExists($dir&"\"& StringMid($startDir, $Rad)) Then DirCreate($dir&"\"& StringMid($startDir, $Rad)) ; Create directory structure to the new location
                  _Excel_BookSaveAs($oWorkbook, $dir & "\" & StringMid($startDir, $Rad) & "\" & $next)
               EndIf
               ;If file is a shortcut, copy the file to the new location --not working for some reason
               If Not StringRight($next, 4) = ".xls" Or Not StringRight($next, 5) = ".xlsx" Then
                  MsgBox(Default, Default, "Copy: " & $startDir & "\" & $next&" To: "& $dir & "\" & StringMid($startDir, $Rad) & "\")
                  FileCopy($startDir & "\" & $next, $dir & "\" & StringMid($startDir, $Rad) & "\")
               EndIf

               ; Write log file
                  FileWriteLine(@DesktopDir & "\RaportIFCSprogress.txt", $startDir & "\" & $next)
                ; Update statusbar with number of processed files
                _GUICtrlStatusBar_SetText($StatusBar1, "Documente procesate: " & $gg)

                _GUICtrlEdit_Scroll($Tracking, $SB_SCROLLCARET)
                GUICtrlSetData($Tracking, $startDir & "\" & $next & @CRLF, 1)

                $gg = $gg + 1
                _Excel_BookClose($oWorkbook, False)


            EndIf

        EndIf
    WEnd
    _Excel_Close($oExcel, False, True)

    FileClose($search)
    If $depth = 0 Then Return StringSplit(StringTrimRight($RFSstring, 1), "*")
    EndFunc   ;==>RecursiveFileSearch



Func FPause()
    $Paused = Not $Paused
    While $Paused
        Sleep(100)
        ToolTip('Script is "Paused"', 0, 0, "", 1)
    WEnd
    ToolTip("")
EndFunc   ;==>FPause

I know the script is messed up and I have probably made something simple, very complicated, but I did my best. 

Thank you. 

Image Replace.au3

Share this post


Link to post
Share on other sites
Jos

How does the script crash? any errors being displayed to indicate where to look?

I do see you are doing an " Local $oExcel = _Excel_Open()" statement with each loop. Shouldn't that be only once?

Jos


SciTE4AutoIt3 Full installer Download page   - Beta files       Read before posting     How to post scriptsource        Forum Rules
 
Live for the present,
Dream of the future,
Learn from the past.
  :)

Share this post


Link to post
Share on other sites
Andreik

And maybe replace that VBA trick with something like this:

#include <Excel.au3>

$PictureName = 'Picture 1'

$oExcel = _Excel_Open(False)
$oBook = _Excel_BookOpen($oExcel,@ScriptDir & '\Test.xlsx')

; Get old picture position
$oShape = $oExcel.Worksheets(1).Shapes($PictureName)
$iTop = $oShape.Top
$iLeft = $oShape.Left
$iWidth = $oShape.Width
$iHeight = $oShape.Height

; Delete old picture
$oShape.Delete

; Add a new picture
$oExcel.Worksheets(1).Shapes.AddPicture(@ScriptDir & "\NewPicture.png", False, True, $iLeft, $iTop, $iWidth, $iHeight)

_Excel_BookSave($oBook)
_Excel_Close($oExcel)

 


When the words fail... music speaks

Share this post


Link to post
Share on other sites
JohnyX
Posted (edited)
1 hour ago, Jos said:

How does the script crash? any errors being displayed to indicate where to look?

I do see you are doing an " Local $oExcel = _Excel_Open()" statement with each loop. Shouldn't that be only once?

Jos

Hello Jos, I moved this line

"Local $oExcel = _Excel_Open()"

on top of While 1, still the script crashed after processing 166 files.

I attached a screenshoot. 

I will try Andreik's method in a few minutes. 

Thanks for your suggestions. 

 

IMG_20180514_130059_406.JPG

Edited by JohnyX

Share this post


Link to post
Share on other sites
JohnyX
Posted (edited)
On 5/14/2018 at 11:55 AM, Andreik said:

And maybe replace that VBA trick with something like this:

#include <Excel.au3>

$PictureName = 'Picture 1'

$oExcel = _Excel_Open(False)
$oBook = _Excel_BookOpen($oExcel,@ScriptDir & '\Test.xlsx')

; Get old picture position
$oShape = $oExcel.Worksheets(1).Shapes($PictureName)
$iTop = $oShape.Top
$iLeft = $oShape.Left
$iWidth = $oShape.Width
$iHeight = $oShape.Height

; Delete old picture
$oShape.Delete

; Add a new picture
$oExcel.Worksheets(1).Shapes.AddPicture(@ScriptDir & "\NewPicture.png", False, True, $iLeft, $iTop, $iWidth, $iHeight)

_Excel_BookSave($oBook)
_Excel_Close($oExcel)

 

Probably I am doing something wrong but when I try to run your script, I am getting this error. 

IMG_20180518_053425_554.thumb.jpg.7258d2fc125fb42531ca129b0d12af94.jpg

Edited by JohnyX

Share this post


Link to post
Share on other sites
water

Did you check that _Excel_Open does not set @error?


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-12-03 - Version 1.4.11.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-10-31 - Version 1.3.4.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
PowerPoint (2017-06-06 - Version 0.0.5.0) - Download - General Help & Support
Excel - Example Scripts - Wiki
Word - Wiki
 
Tutorials:

ADO - Wiki

 

Share this post


Link to post
Share on other sites
Andreik

Be sure _Excel_Open returns a valid object and also be sure you have the variable $PictureName with appropriate content.


When the words fail... music speaks

Share this post


Link to post
Share on other sites
water

BTW: Which version of AutoIt do you run?


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-12-03 - Version 1.4.11.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-10-31 - Version 1.3.4.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
PowerPoint (2017-06-06 - Version 0.0.5.0) - Download - General Help & Support
Excel - Example Scripts - Wiki
Word - Wiki
 
Tutorials:

ADO - Wiki

 

Share this post


Link to post
Share on other sites
JohnyX
Posted (edited)
On 5/14/2018 at 11:39 AM, Jos said:

Hello, 

Sorry for late reply, I only had to insert some Sleep(500) in between some of the commands and now it work good. 

I guess it couldn't process everything so fast. 

Thank you all for your help! 

Edited by JohnyX

Share this post


Link to post
Share on other sites
JohnyX
On 5/14/2018 at 11:55 AM, Andreik said:

And maybe replace that VBA trick with something like this:

#include <Excel.au3>

$PictureName = 'Picture 1'

$oExcel = _Excel_Open(False)
$oBook = _Excel_BookOpen($oExcel,@ScriptDir & '\Test.xlsx')

; Get old picture position
$oShape = $oExcel.Worksheets(1).Shapes($PictureName)
$iTop = $oShape.Top
$iLeft = $oShape.Left
$iWidth = $oShape.Width
$iHeight = $oShape.Height

; Delete old picture
$oShape.Delete

; Add a new picture
$oExcel.Worksheets(1).Shapes.AddPicture(@ScriptDir & "\NewPicture.png", False, True, $iLeft, $iTop, $iWidth, $iHeight)

_Excel_BookSave($oBook)
_Excel_Close($oExcel)

 

Can anyone please tell me if there is a way to replace the existing image using the cell range where the image is located (eg. A5) instead of using the picture name ("Picture 1" in my case)? 

I need to replace the image using the old coordinates and ratio aspect and this script does just that. But the image name is not the same on all files. 

Thank you very much. 

Share this post


Link to post
Share on other sites
water

You could loop through the Shapes collection and process the Shape where its TopleftCell property has the expected value.
Please have a look at : https://msdn.microsoft.com/en-us/vba/excel-vba/articles/shape-topleftcell-property-excel


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-12-03 - Version 1.4.11.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-10-31 - Version 1.3.4.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
PowerPoint (2017-06-06 - Version 0.0.5.0) - Download - General Help & Support
Excel - Example Scripts - Wiki
Word - Wiki
 
Tutorials:

ADO - Wiki

 

Share this post


Link to post
Share on other sites
JohnyX

This is way over my head, I will try to figure it out and write some code and I'll be back with the results.

Thank you. 

Share this post


Link to post
Share on other sites
water

Something like this (untested):

For $oShape In $oWorkbook.ActiveSheet.Shapes
    If $oShape.TopLeftCell.Address = "$A$1" Then
        ; Process $oShape here ...
        ExitLoop
    EndIf
Next

Checks if a shapes upper left corner covers cell "A1".


My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-12-03 - Version 1.4.11.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-10-31 - Version 1.3.4.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
PowerPoint (2017-06-06 - Version 0.0.5.0) - Download - General Help & Support
Excel - Example Scripts - Wiki
Word - Wiki
 
Tutorials:

ADO - Wiki

 

Share this post


Link to post
Share on other sites
aa2zz6
Posted (edited)
9 hours ago, water said:

Something like this (untested):

For $oShape In $oWorkbook.ActiveSheet.Shapes
    If $oShape.TopLeftCell.Address = "$A$1" Then
        ; Process $oShape here ...
        ExitLoop
    EndIf
Next

Checks if a shapes upper left corner covers cell "A1".

I was looking at doing similar for work to what @JohnyX is looking for I believe. Can you explain how $oshapes work? I used the _excel_PictureAdd instead.

#include <Excel.au3>
#include <MsgBoxConstants.au3>

; Create application object and open an example workbook
$oExcel = _Excel_Open(False)
$oBook = _Excel_BookOpen($oExcel, @ScriptDir & '\Test.xlsx')

If @error Then Exit MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_PictureAdd Example", "Error creating the Excel application object." & @CRLF & "@error = " & @error & ", @extended = " & @extended)
; Create new Workbook

If @error Then
    MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_PictureAdd Example", "Error creating workbook." & @CRLF & "@error = " & @error & ", @extended = " & @extended)
    _Excel_Close($oExcel)
    Exit
EndIf

; Insert and resize the picture into a range of cells. Aspect ratio retained
Local $PictureName = @ScriptDir & "\img1.jpg"
Local $PictureName1 = @ScriptDir & "\img2.jpg"

; Insert the picture with a defined size/height.
_Excel_PictureAdd($oBook, Default, $PictureName, "A1", Default, 300, 250)
If @error Then Exit MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_PictureAdd Example 3", "Error inserting picture." & @CRLF & "@error = " & @error & ", @extended = " & @extended)
;MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_PictureAdd Example 3", "Picture inserted at 'A8' with defined size/height, aspect ratio ignored")

For $oShape In $oBook.ActiveSheet.Shapes
    If $oShape.TopLeftCell.Address = "$A$1" Then
        ; Delete old picture
        $oShape.Delete
        _Excel_PictureAdd($oBook, Default, $PictureName1, "A1", Default, 300, 250)
        ExitLoop
    EndIf
Next

_Excel_BookSave($oBook)
_Excel_Close($oExcel)

 

Edited by aa2zz6

Share this post


Link to post
Share on other sites
JohnyX

Maybe I am able to help, thanks to water, my script is almost complete. 

Can you explain what exactly are you trying to achieve? 

Share this post


Link to post
Share on other sites
JohnyX
18 hours ago, water said:

Something like this (untested):

For $oShape In $oWorkbook.ActiveSheet.Shapes
    If $oShape.TopLeftCell.Address = "$A$1" Then
        ; Process $oShape here ...
        ExitLoop
    EndIf
Next

Checks if a shapes upper left corner covers cell "A1".

Can you please tell me if there are other  options similar to:

$oShape.TopLeftCell.Address = "$A$1"

(I guess there could be 

$oShape.TopRightCell.Address = "$A$1"

$oShape.BottomLeftCell.Address = "$A$1"

etc..) 

and where can I find this information? 

Thanks. 

Share this post


Link to post
Share on other sites
water

My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2018-12-03 - Version 1.4.11.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX (2018-10-31 - Version 1.3.4.1) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
PowerPoint (2017-06-06 - Version 0.0.5.0) - Download - General Help & Support
Excel - Example Scripts - Wiki
Word - Wiki
 
Tutorials:

ADO - Wiki

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×