PDA

View Full Version : Checking Excel background image with VBA



hondaum
05-13-2016, 12:05 PM
Hi there folks,

I have a small program written in VBA (inside excel) and the basic interface and some fancy stuff is just created by a jpg image set manually on the main sheet of my excel file.
I was wondering if is there any way to check if someone changed that picture so i can quit the program (meaning that someone changed the original program).
Anyone can help me? I've tryed several times to look in googles results but nothing really enlightening came up. Thanks for your help! :yes And sorry about my bad english :doh:

Kenneth Hobs
05-13-2016, 02:18 PM
Welcome to the forum!

I would protect it and not let them change it. Of course you need to protect your vbaproject as well or else they could modify your code.

There are two ways. (1) check the sheet1.shapes(1).Name though they could change that. (2) export the image to a file and check number of bytes.

hondaum
05-14-2016, 04:01 PM
Welcome to the forum!

I would protect it and not let them change it. Of course you need to protect your vbaproject as well or else they could modify your code.

There are two ways. (1) check the sheet1.shapes(1).Name though they could change that. (2) export the image to a file and check number of bytes.



Hi there. Thanks for your quick reply!
I was thinking on how to check for shape.name if that is not a shape... i'm using that "page layout > background" option in excel. Is not really a shape... =\
About protecting my vba code, it's already done, thanks.

Any other ideas? :yes

Kenneth Hobs
05-14-2016, 06:28 PM
Sub Main()
Dim pic As String
pic = "C:\Users\Ken\Pictures\ToroMufflerParts.PNG"
If ActiveSheet.SetBackgroundPicture <> pic Then
ActiveSheet.SetBackgroundPicture = pic
End If
End Sub

Aussiebear
05-15-2016, 03:49 AM
Given the poor explanation Kenneth, I think your solution is excellent.

SamT
05-15-2016, 04:56 AM
When Kenneth is on the job, I don't bother responding because I know that I cannot do as well.

Paul_Hossler
05-15-2016, 08:19 AM
Sub Main()
Dim pic As String
pic = "C:\Users\Ken\Pictures\ToroMufflerParts.PNG"
If ActiveSheet.SetBackgroundPicture <> pic Then
ActiveSheet.SetBackgroundPicture = pic
End If
End Sub

Ken --

I get a error 450 = 'Wrong number of arguments or invalid property assignment' on



If ActiveSheet.SetBackgroundPicture <> pic Then



using my own picture and folders of course

I believe that .SetBackgroundPicture is a method and doesn't return the background file name



OP said ...


I was wondering if is there any way to check if someone changed that picture so i can quit the program (meaning that someone changed the original program).

so I'm trying to see how if another user DID change the picture that would sense the changeand exit the macro


Also, as far as I can tell, the file name is not stored as a property, the actual picture is stored in the \Media subfolder of the xlsm 'zip' file

16184

Kenneth Hobs
05-15-2016, 09:04 AM
Thanks Paul. I normally check my code before posting. The only way I see right now is to set it. Also, protection has no effect and there is no trigger to know when the method was evoked.

For ThisWorkbook object, this will take care of the problem on Open.

Private Sub Workbook_Open()
Dim pic As String
pic = "C:\Users\Ken\Pictures\ToroMufflerParts.PNG"
'pic = ""
Worksheets("Sheet1").SetBackgroundPicture pic
End Sub

Paul_Hossler
05-15-2016, 07:31 PM
Setting it is no problem


OP said ...

I was wondering if is there any way to check if someone changed that picture so i can quit the program (meaning that someone changed the original program).




Seeing if it was changed is harder


Your comment in #2


(2) export the image to a file and check number of bytes.

might be the only viable way but requires 'breaking in' to the XML of the xlsm file, and even then it might not be possible to determine which is the correct image

Kenneth Hobs
05-16-2016, 05:35 AM
might be the only viable way but requires 'breaking in' to the XML of the xlsm file, and even then it might not be possible to determine which is the correct image
Right Paul.

If the OP wants me to explore this method, attach the file by clicking the Go Advanced button in lower right of a reply. Click the Paperclip icon in the toolbar and Browse and Upload.

The manual steps to see the media file(s) are:
1. Rename a copy of the file in Windows Explorer.
2. Change the file extension to ZIP.
3. Open the ZIP file.
4. Open the xl\media folder and note the file(s) there.

If no other media file was in step 4, then a macro using that method and checking FileSize should work. It could also work if you know the FileSize() which you do, and then see if any file in xl\media has the same size. If not, then they have changed or deleted that media file. It could be that some file sizes are the same but not the same content. That possibility should be fairly remote though.

Method 2 may be possible.
1. Copy the file or just the sheet.
2. Open the file and delete all sheets but the one that needs the background file checked.
3. Save the file. Note the FileSize.
4. Open the file.
5. Set the background file.
6. Save the file.
7. Did the FileSize change?

I am not confident in method 2 as overhead/bloat may affect file sizes.

Paul_Hossler
05-16-2016, 06:53 AM
Hi there folks,

I have a small program written in VBA (inside excel) and the basic interface and some fancy stuff is just created by a jpg image set manually on the main sheet of my excel file.
I was wondering if is there any way to check if someone changed that picture so i can quit the program (meaning that someone changed the original program).
Anyone can help me? I've tryed several times to look in googles results but nothing really enlightening came up. Thanks for your help! :yes And sorry about my bad english :doh:

Even if someone changed the background image, the original program would still not be changed. It's only an image and only affects that the worksheet looks like

I wonder if there is a terminology issue since the background image doesn't actually run macros

In the attachment, Sheet1 has a background image, and Sheet2 has a image that runs a macro when you click it


Can you post a small sample workbook?

SamT
05-16-2016, 06:56 AM
(meaning that someone changed the original program).
I wonder if a character count in the VBE would work? If it would, then while in the VBE Coding, delete all modules and Excel Object's code.

I had a client who wanted a simple time based protection scheme for a price estimating book. I had him add a custom Property field (Last Update Date) to the book and gave him code that when 30 days had passed, all the data and reference sheets except the price estimates were deleted.

snb
05-16-2016, 07:23 AM
... if macros were enabled.

All these suggestions assume macros to be enabled. If not, the code is redundant.

hondaum
05-17-2016, 11:18 AM
Even if someone changed the background image, the original program would still not be changed. It's only an image and only affects that the worksheet looks like

I wonder if there is a terminology issue since the background image doesn't actually run macros

In the attachment, Sheet1 has a background image, and Sheet2 has a image that runs a macro when you click it


Can you post a small sample workbook?



Hi there folks.. .sorry about my delay in getting back here.
I understand what you said about "its only an image" ... sure it is, but its the only (and lighter, and faster) characteristic that prevents the program from being stollen.
Anyone could take my work, change the background image and then scream that he or she wrote the program. Its so simple that i wanted to avoid that...
Guess there is not a solution for that.

And about the "setbackgroundimage", it is only available to set new images. It is not meant to do anything else... at least as far as i know now.
Also, as Paul said,the actual picture is stored in the \Media subfolder of the xlsm 'zip' file.

Also, as additional information, i'm trying to avoid from being stollen, so obviously the program will run on different computers (not only mine).
So, i cannot check for local files as they must not be there in someone else's computer. It has to be a standalone solution.

Thanks again for all your attention,
Best regards
Rodrigo

SamT
05-17-2016, 04:33 PM
Add a reference to MicroSoft Visual Basic For Applications Extensibility

In VBA, Object Explorer, look in VBIDE, at VBComponent and CodeModule. In CodeModule, notice CountOfLines and CountOfDeclarationLines.

Add a Standard module modLegals that any thief will be sure to delete.
Add the EULA as a comment.

Declare some constants

Public Const strOwner As String = "Hondaum"
Public Const strDate As String ="05/17/2016"
Public Const AllRightsReserved As boolean = True

Add a sub

Public Sub Copyright()
MsgBox "CopyRight Hondaum, 2016, blah, blah, blah"
End Sub

Declare a public constant to hold the number of lines in the project.
Scattered throughout your existing code, use the Objects and properties in the added reference to find the total count of lines in the project. Add lines that can compare that value to the aforementioned public constant and Delete all Modules in the project if there is a difference. Comment out these line and count them.

In another workbook, again count the total lines in this project, add the number of commented out lines and set the value of that public constant.

Obfuscate your code:
Never use common names for common variables like rng, Cel, i, LastRow etc. Use a different uncommon name in each sub or function. always declare them in other modules as public project wide variables. Use Functions in different modules to set the values of those variables.

For Example:
In module1 Public rngSamT as Range
In module1 Public Const abc As String = "A"
in module2 Public iSamT as double 'a misdirection. won't affect the code
in module2Public Const ghi As String = ""
in module3 public celSamT as Object 'another misdirection.
in module5 Public Const xyz As String = "sheet1"

in module4:
This

Sub CountXes()
Dim rng as Range
Dim Cel As Range
Dim i As long

Set Rng = Sheets("Sheet1").Range("A:A")
For Each Cel in Rng
If Cel = "X" Then
i = i + 1
End If
Next
End Sub
becomes

Sub SamT()

Set rngSamt = Public_Function_in_Module3
For Each celSamT in rngSamT
If celSamT <> ghi Then
iSamT = iSamT + someSamTvar
End If
Next
End Sub

Function Public_Function_in_Module3()
Set Public_Function_in_Module3() = Sheets(xyz).Range(abc)
End Function

The end result is that all variables and constants are public and none are declared in the module in which they are used. All variables are set by dedicated function in a different module.

finally, use Ctrl+H to replace all Constant, variable, sub, and function names project wide with equal length random characters:
Replace ghi with XKLWERMAIO
Replace rngSamT with XOSDNUDHKAL
Replace (sub ) SamT with FIDMVKKSNE
Replace Public_Function_in_Module3() with GKSIOMCPTL
and so forth.

keep a list of the strange names you use. Do NOT duplicate any of them.

Delete all white space and indents.

The results:
Sub FIDMVKKSNE()
Set XOSDNUDHKAL = GKSIOMCPTL
For Each ABCDEFGHIK in XOSDNUDHKAL
If ABCDEFGHIK <> XKLWERMAIO Then
ZYXWVUTSRQ = ZYXWVUTSRQ + GHIJKLMNOP
End If
Next
End Sub

Kenneth Hobs
05-17-2016, 05:25 PM
With some work, I can show you how in a macro to check if a media file has the same filesize as I said. If no media file is found or none have the same size, you know it was changed.

What you do based on the change is up to you. One thing might be to hide all but one sheet in the Close event. When it Opens, do the check and if exists, then unhide all sheets and hide the intro sheet.

GTO
05-18-2016, 01:51 AM
...One thing might be to hide all but one sheet in the Close event....

Hi Ken,

FWIW, I do not recall seeing the close event used for this without either (a) forcing a save each time the workbook closes (and risking that the user has just tried to bailout w/o saving cuz they know they just goobered something up), or (b) some way of the user getting around it depending on the order of stuff they do. I do not recall the details, but that is what I remember. Anyways, I would suggest the BeforeClose event instead.

Mark

Kenneth Hobs
05-21-2016, 12:21 PM
Mark, I consider the issue of hiding sheets to make the file more secure a separate thread. I believe that you and several others have answered that sort of question several times. I know that I have.

As for checking the background file on a sheet, as I explained earlier, the closest one can get is to know the name and the file size as stored in a zip file's xl/media folder. This is not an absolute solution for that part but should work 99% of the time. Note the comment in the function where I show how to find out media file names and file sizes.

There may be a way to get the full paths as shown in a zip file when one mouse's over the zip file but I don't see it right now. Iteration through it is easy enough though.


Sub Test_MediaFileExists()
MsgBox MediaFileExistsInSheet(ActiveSheet, "image2.PNG", 168076), _
vbInformation, "Media File Exists"
End Sub


'In Tools > References..., add: Microsoft Shell Controls and Automation
Function MediaFileExistsInSheet(mfWorksheet As Worksheet, _
mfName As String, mfSize As Double) As Boolean

Dim oShellApp As New Shell32.Shell
Dim ZipFile As String, oFile As ShellFolderItem
Dim oFile2 As ShellFolderItem, oFile3 As ShellFolderItem
Dim tf As Boolean, mfFile As String

On Error Resume Next
Application.DisplayAlerts = False

ZipFile = Environ("temp") & "\MediaFileExistsInSheet.zip"
Kill ZipFile
mfFile = Environ("temp") & "\MediaFileExistsInSheet.xlsx"
'mfWorksheet.SaveAs mfFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
CopySheet mfWorksheet, mfFile
Name mfFile As ZipFile

tf = False
For Each oFile In oShellApp.Namespace(ZipFile).Items
With oFile
If .Name = "xl" Then
For Each oFile2 In oFile.GetFolder.Items
If oFile2.Name = "media" Then
For Each oFile3 In oFile2.GetFolder.Items
'Debug.Print LCase(oFile3.Name) ,LCase(mfName), oFile3.size ,mfSize 'oFile3.Type, oFile3.Path
'Uncomment above and comment If below to see all media file names _
and sizes in Immediate window.
If LCase(oFile3.Name) = LCase(mfName) And _
oFile3.size = mfSize Then
tf = True
GoTo EndNow
End If
Next oFile3
End If
Next oFile2
End If
End With
Next

EndNow:
Application.DisplayAlerts = True
MediaFileExistsInSheet = tf
End Function


Sub CopySheet(sht As Worksheet, thePath As String)
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
sht.Copy after:=.Sheets(1)
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
.ActiveSheet.Name = sht.Name
.SaveAs thePath
.Close False
End With
Application.ScreenUpdating = True
End Sub

Kenneth Hobs
05-23-2016, 01:37 PM
As I thought, here is an easy way to get a list of the contents in a zip file without unzipping it.

Sub Test_ZipContentsToArray()
Dim a() As String
a() = ZipContentsToArray(Environ("temp") & "\MediaFileExistsInSheet.zip")
MsgBox Join(a(), vbLf)
End Sub


Rem Needs Tools > References..., add: Microsoft Shell Controls and Automation
Function ZipContentsToArray(zipFile As String) As Variant
Dim objShell As Shell, objFolder As Folder, objFolderItem As FolderItem
Dim zipPath As String, sArray() As String
Dim FSO As FileSystemObject


Set FSO = New FileSystemObject
With FSO
If Not .FileExists(zipFile) Then
MsgBox zipFile, vbCritical, "File Does Not Exists"
Exit Function
End If
zipPath = .GetParentFolderName(zipFile)
zipFile = .GetFileName(zipFile)
End With

Set objShell = New Shell
Set objFolder = objShell.Namespace(zipPath)
Set objFolderItem = objFolder.ParseName(objFolder.ParseName(zipFile))
sArray() = Split(objFolder.GetDetailsOf(objFolderItem, -1), vbLf)
ZipContentsToArray = sArray()
End Function

patcell67
05-24-2016, 10:53 AM
When you say verify the background photo, i don't understand the purpose of the code.

Kenneth Hobs
05-24-2016, 11:11 AM
A sheet's backgound picture can be set by anyone no matter even if the sheet and workbook is protected. The OP wanted a way to not allow that to happen. The workbook's Open event can be used to evaluate if that happened. While not perfect, if one knows the filename that Excel saved the background image to and the file size, one can make that verification. Post #18 shows how to check.

Of course post #19 can be used too if one wanted to check for filename only. It also has uses for other problems as well.