Deploying Macros as Add Ins with Custom Ribbon Buttons to the entire office - excel

I have been searching for a way to distribute macros to my tech illiterate office in the simplest way I can.
From my research, saving the Macros into a .xlam add-in would seem to be headed in the right direction.
Is it also possible to set up a custom ribbon tab in this manner?
Thus far I have failed to find any guides and our office security may also block certain avenues.
Edit:
Using W-Hit's excellent solution, and setting up the folder structure as indicated, it definitely helps make deploying an update much easier with the DeployAddIn subroutine.
I also found it useful to put the DeployAddIn and InstallAddin subroutines into a custom ribbon tab of their own!
I ran into a problem with the InstallAddin subroutine however: how to format the XML text in VBA without running into syntax errors.
I discovered that Each Element must have mso at the start e.g. <button> becomes <mso:button> and each "speech marked section" in a line must have ""double speech marks".
Perhaps the easiest way to use this install function is to save and edit the code into an active file, then open C:\Users[username]\AppData\Local\Microsoft\Office\Excel.officeUI in Notepad++. Then simply perform a find and replace to add in the extra quotation marks and paste it into the ribbonXML = "insert your text here" section of the code, ensuring it is encapsulated by the final speech marks to mark the entire section as a text string.
I might also look into adding extra functionality here... having an inputbox or userform that allows you to paste the code in at this point rather than have you enter the VBA editor to paste it in.

I currently do this, and it's a somewhat in depth process to setup, but runs smoothly once it is.
1st step is to create a folder structure with testing and production copies of your .xlam files that you are the admin for.
2nd, in the production folder, right click all .xlam files and set the attributes in the properties to Read-only. If you don't you'll never be able to update the addin if anyone else is in it.
3rd, when you make updates to the code in the testing file, just replace the production file with the updated file, and change to Read-only again. Users will only have to close all instances of excel and reopen to have the most up-to-date copy of the add-in.
Below is an admin add-in I use to move testing files to production.
Sub DeployAddIn()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: To deploy finished/updated add-in to a network
' location as a read only file
Dim strAddinDevelopmentPath As String
Dim strAddinPublicPath As String
Dim FSO As New FileSystemObject
'Set development path
ChDrive "R:"
ChDir "R:\addins\PROJECTS"
strAddinDevelopmentPath = Application.GetOpenFilename()
If strAddinDevelopmentPath = "False" Then
Exit Sub
ElseIf InStr(strAddinDevelopmentPath, "\PRODUCTION\") > 1 Then
If MsgBox("You've Selected a Production File To Replace a Production File. Would You Like To Continue Anyway?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
'Get Desitination path
strAddinPublicPath = Replace(strAddinDevelopmentPath, "TESTING", "PRODUCTION")
'Create dir if it doesn't exist
On Error Resume Next
MkDir Left(strAddinPublicPath, InStrRev(strAddinPublicPath, "\") - 1)
On Error GoTo 0
'Turn off alert regarding overwriting existing files
Application.DisplayAlerts = False
'overwrite existing file
On Error Resume Next
SetAttr strAddinPublicPath, vbNormal
On Error GoTo 0
FSO.CopyFile strAddinDevelopmentPath, strAddinPublicPath, True
SetAttr strAddinPublicPath, vbReadOnly
'Resume alerts
Application.DisplayAlerts = True
End Sub
4th, I've also written a macro to change the custom ribbon. The below link, in addition Ron deBruin's site is useful. https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Code to automate addin install after you get the right text from the officeUI file
Sub InstallAddin()
'Adapted from https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Dim eai As Excel.AddIn
Dim alreadyinstalled As Boolean
Dim ribbonXML As String
'check if already installed
For Each eai In Application.AddIns
If eai.Name = "Main addin.xlam" Then
eai.Installed = False
Exit For
End If
Next
'add and install the addin
Set eai = Application.AddIns.Add("path to Main addin.xlam", False)
eai.Installed = True
'append quick access ribbon xml to add button
ClearCustRibbon
LoadNewRibbon
'have to close addin for it to load properly the first time
Workbooks("Main addin.xlam").Close
End Sub
Sub ClearCustRibbon()
'https://social.msdn.microsoft.com/Forums/vstudio/en-US/abddbdc1-7a24-4664-a6ff-170d787baa5b/qat-changes-lost-when-using-xml-to-modify-ribbon-excel-2016-2016?forum=exceldev
Dim hFile As Long
Dim ribbonXMLString As String
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXMLString = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon>" & _
"<mso:qat>" & _
"<mso:sharedControls>" & _
"</mso:sharedControls>" & _
"</mso:qat>" & _
"</mso:ribbon>" & _
"</mso:customUI>"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXMLString
Close hFile
End Sub
Sub LoadNewRibbon()
Dim hFile As Long
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXML = "your ribbon text here"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
End Sub
***IMPORTANT---- If you install the addin manually, make sure you select no when prompted if you want the file saved to the local machine. If you save it to the local machine, it creates a local copy, and will never update if you make changes to the network copy or need to fix an error.
There are more tips, but you'll mostly need to adapt them to fit how you operate. Hope that helps.

Related

How to programmatically export and import code into Excel worksheet?

We will put 100s of Excel worksheets out in the field this year. The code periodically needs to be updated when bugs are found. For last year's effort, I was able to dynamically have workbooks pull updates for .bas files. This year I want to dynamically have workbooks pull updates for the code embedded in the worksheets too.
EXPORT CODE
The export code is pretty simple, but there are artifacts in the .txt files
Sub SaveSoftwareFile(path$, name$, ext$)
ThisWorkbook.VBProject.VBComponents(name).Export path & name & ext
Example Call: SaveSoftwareFile path, "ThisWorkbook", ".txt"
The problem is that the export has a lot of header information that I don't care about (in red). I just want the part in blue. Is there switch that allows me not to save it, or do I have to manually go into the export and remove it myself?
IMPORT CODE
The import code is pretty straight forward too, but it causes the error "Can't enter break mode at this time", and I'm struggling to figure out the right path forward. If I manually try and delete this code, Excel is also unhappy. So maybe my approach is altogether incorrect. Here's the code:
Sub UpgradeSoftwareFile(path$, name$, ext$)
Dim ErrorCode%, dest As Object
On Error GoTo errhandler
Select Case ThisWorkbook.VBProject.VBComponents(name).Type
Case 1, 3 'BAS, FRM
<Not relevant for this discussion>
Case 100 'Worksheets
Set dest = ThisWorkbook.VBProject.VBComponents(name).codemodule
dest.DeleteLines 1, dest.CountOfLines 'Erase existing | Generates breakpoint error
dest.AddFromFile path & name & ext '| Also generates breakpoint error
End Select
Example Call: UpgradeSoftwareFile path, "ThisWorkbook", ".txt"
Thanks in advance for your help
Please, try the next way of exporting and you will not have the problem any more:
Sub SaveSoftwareFile(path$, sheetCodeModuleName$, FileName$)
Dim WsModuleCode As String, sCM As VBIDE.CodeModule, strPath As String, FileNum As Long
Set sCM = ThisWorkbook.VBProject.VBComponents(sheetCodeModuleName).CodeModule
WsModuleCode = sCM.Lines(1, sCM.CountOfLines)
'Debug.Print WsModuleCode
strPath = ThisWorkbook.path & "\" & FileName
FileNum = FreeFile
Open strPath For Output As #FileNum
Print #FileNum, WsModuleCode
Close #FileNum
End Sub
You can use the above Sub as following:
Sub testSaveSheetCodeModule()
Dim strPath As String, strFileName As String, strCodeModuleName As String
strPath = ThisWorkbook.path
strFileName = "SheetCode_x.txt"
strCodeModuleName = Worksheets("Test2").codename 'use here your sheet name
SaveSoftwareFile strPath, strCodeModuleName, strFileName
End Sub
Now, the created text file contains only the code itself, without the attributes saved by exporting the code...
Import part:
"Can't enter break mode at this time" does not mean that it is an error in the code. There are some operations (allowed only if a reference to Microsoft Visual Basic for Applications Extensibility ... exists) in code module manipulation, which cannot simple be run step by step. VBA needs to keep references to its VBComponents and it looks, it is not possible when changes in this area and in this way are made.
The import code is simple and it must run without problems. You must simple run the code and test its output...

DocumentExport copies pdf to an excel page but leaves a copy of the pdf open, which I cannot close

I have a Microsoft project vba application where I want to copy a selection of tasks using the "marked" field to identify all of the predecessor tasks to a target task, identified as the "target" below. When I have traced the network back to include only incompleted tasks, control passes to a routine which uses DocumentExport to create a copied file and save it to a pdf. Then, using ActiveSheet.OLEObjects.add, take this PDF and copy to a specific excel Tab with the "A3" cell being the top/left corner for the file to be placed.
excerpts of my current code:
target = ActiveCell.Task
SaveFilePath = "C:\Macros\"
SaveFileName = SaveFilePath & "Target-" & target & ".pdf"
SaveFilePath = "C:\Macros\"
SaveFileName = SaveFilePath & "Target-" & target & ".pdf"
Application.FilePageSetupView Name:=".MarkedPred_View", allsheetcolumns:=True, BestPageFitTimescale:=True
Application.FilePageSetupPage Name:=".MarkedPred_View", Portrait:=False, PagesTall:=6, PagesWide:=1, PaperSize:=pjPaperLegal, FirstPageNumber:=False
StrHeader = "&18&B" & GetFontFormatCode("Calibri") & "Status Date=" & Format(ActiveProject.StatusDate, "mm/dd/yy") & " Task Name= " & SelTask.Name & " ID:" & SelTask.ID & " UID:" & SelTask.UniqueID
Application.FilePageSetupHeader Name:=".MarkedPred_View", Alignment:=pjCenter, Text:=StrHeader
Application.FilePageSetupLegend Name:=".MarkedPred_View", LegendOn:=pjNoLegend
DocumentExport SaveFileName, pjPDF, FromDate:=EarliestStart - 30, ToDate:=LFin + 30
xlsheet.Range("A3").Select
ActiveSheet.OLEObjects.Add(FileName:=SaveFileName, Link:=True _
, DisplayAsIcon:=False).Activate
If I set the Link property to false, the copy to excel does not happen
sbDeleteAFile (SaveFileName)
Sub DeleteAFile(ByVal FileToDelete As String)
IsFileOpen (FileToDelete)
SetAttr FileToDelete, vbNormal
Kill FileToDelete
End Sub
Function IsFileOpen(FileName As String)
Dim filenum As Integer, errnum As Integer
OutputStr = ("1587 - IsFileOpen - started for = " & FileName) 'added
Call Txt_Append(MyFile, OutputStr)
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open FileName For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
Case 0
IsFileOpen = False
'Open (Filename)
' Error number for "Permission Denied."
' File is already opened by another user.
OutputStr = ("1587 - IsFileOpen - is NOT Open") 'added
Call Txt_Append(MyFile, OutputStr)
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
OutputStr = ("1587 - IsFileOpen - IS Open") 'added
Call Txt_Append(MyFile, OutputStr)
Error errnum
End Select
End Function
"LFin" is the finish date of the target task, from which I am collecting all of its predecessors. I am using the finish date as the "Latest Finish" (LFIN) to bound the "ToDate" in the command.
The error appears with the "ActiveSheet.OLEObjects.Add (fileName:=SaveFilename, Link:=True _" command, where the PDF is opened and copied to the specified excel tab with cell "A3" being the point of the paste for the image.
I do not have any code to close the PDF in this snippet so I get an error when I try to delete an open file. I have seen lots of discussion on various boards where if a file is opened by another application, MS Project VBA cannot delete it as it does not have the handle to the file (??). If I manually close the PDF, close the error notification in the debugger and then press "Run/Continue" , the PDF is deleted and cycles back through the main routine, just like I want it to but I have to again close the newly created PDF, clear the dialog and select Run/Continue.
The only section of this code which does not work as desired (and is currently missing in this code) is having the ability to close the PDF after it has been copied to Excel as it is no longer needed. I have only seen very complicated code which gets the handle of the PDF and then allows you to close the specific file without affecting any other PDF files which may also be open and are not part of this process.
Does anyone have any ideas? I first started using CopyToClipboard, but this command only can copy 16 rows of MS Project schedule to the clipboard. Then, I tried ExportAsFixedFormat, but the FromDate and ToDate entries have no effect on the displayed image.
Using DocumentExport and Application.OLEObjects.Add allows me to copy unlimted pages of schedule to the clipboard and paste into an excel tab showing the desired dates only.This is the closest I have been able to come to get what I want the output to look like. I have been unable to find an associated command to Application.OLEObjects.Add command which I can use to close the PDF file created by the Application.OLEObjects.Add. It certainly makes sense that you want to open the PDF file so it can be copied to the Excel tab, but it is surprising there is not also an easy way to close that PDF file after it has served its purpose.
The question boils down to this:
The error appears with the "ActiveSheet.OLEObjects.Add
(fileName:=SaveFilename, Link:=True, DisplayAsIcon:=False).Activate" command, where the PDF is
opened and copied to the specified excel tab...
The reason the pdf file opens is that the code is telling it to. By using the Activate method on the OLEObject just added, it activates it--meaning in opens the pdf file.
The solution is to simply the OLEObjects.Add method to this:
ActiveSheet.OLEObjects.Add FileName:=SaveFileName

How would I prevent multiple users from editing the same Excel file?

Whenever a specific Excel file is in use, I'd like to prevent anyone else editing it.
ie. "This file is currently being edited by John Dow, and it will now close".
I'm looking for something simple.
Any ideas?
Thank you,
D.
I'm going to add an answer to this which I'll have to say is nowhere near perfect (blatantly trying to avoid down-votes for trying to do something that isn't really necessary).
I just wanted to see if you could extract the name of the person that has it open - after all, it does normally give the name of the person who has it locked for editing when you first open a workbook.
When you open an Excel file a hidden lock file is created in the same folder. The lock file has the same name as the original with ~$ appended to the front of the file name.
I found you can't copy the lock file using the VBA FileCopy as you get a Permission denied error, but you can using the FileSystemObject CopyFile.
The thinking behind my method is to copy the lock file and change it to a text file. You can then pull the user name from it and compare it against the current user name - if it's different then report that and close the file.
Note - I wouldn't use this in a project as there seems to be a few places it can fall over, and Excel will generally tell you that someone else has it open anyway. It was more of a coding exercise.
Private Sub Workbook_Open()
Dim ff As Long
Dim sLockFile As String
Dim sTempFile As String
Dim oFSO As Object
Dim XLUser As String, LoggedUser As String
Dim fle As Object
sLockFile = ThisWorkbook.Path & Application.PathSeparator & "~$" & ThisWorkbook.Name
sTempFile = Replace(sLockFile, "~$", "") & "tmp.txt"
'Create copy of lock file as a text file.
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CopyFile sLockFile, sTempFile, True
'Read the first line from the text file.
ff = FreeFile()
Open sTempFile For Input Lock Read As #ff
Line Input #1, XLUser
Close ff
'Remove the current user from the text.
'Need to check this so that it doesn't close because it sees the current user name.
XLUser = Replace(XLUser, Application.UserName, "")
'Extract name from text string.
'There is a double space in the InStr section.
'The double exclamation mark is a single character - I don't know the code though.
'Unicode U+0203C I think.
XLUser = Replace(Left(XLUser, InStr(XLUser, " ") - 1), "", "")
'Remove hidden attributes so temp file can be deleted.
Set fle = oFSO.GetFile(sTempFile)
fle.Attributes = 0
Kill sTempFile
'If there's still text then it's a user name - report it and close.
If Len(Trim(XLUser)) > 0 Then
MsgBox "Workbook is already open by " & XLUser
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
Having put all that, this code is probably safer:
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "Is opened in read only.", vbOKOnly
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

Best way to replace VBA code in multiple files?

I used to use something like this:
Dim vbaComponent As Variant
For Each vbaComponent In inputWorkbook.VBProject.VBComponents
vbaComponent.CodeModule.DeleteLines 1, vbaComponent.CodeModule.CountOfLines
vbaComponent.CodeModule.AddFromFile importComponentFileName
Next vbaComponent
This worked perfectly for some time but now it crashes when the Excel file gets saved. I guess the files got too big or something.
Is there better way to do this?
EDIT:
The problem seems to be frm and cls files. The replacement of bas files works perfectly.
EDIT2:
On some machines even bas files don't work.
EDIT3 (My current solution):
So my current solution was simply doing it by hand once and recording all mouse and keyboard input and then replaying this over and over again.
If there is no proper solution to this I plan on creating an AutoIt script for this.
you will have to export/import components, because not all lines are exposed to CodeModule, here is sample
Private Sub exportImportComponent(Project1 As VBIDE.VBProject, Project2 As VBIDE.VBProject)
Dim i As Long, sFileName As String
With Project1.VBComponents
For i = 1 To .Count
sFileName = "C:\Temp\" & .Item(i).Name
Select Case .Item(i).Type
Case vbext_ct_ClassModule
.Item(i).Export sFileName & ".cls"
Project2.VBComponents.Import sFileName & ".cls"
Case vbext_ct_StdModule
.Item(i).Export sFileName & ".bas"
Project2.VBComponents.Import sFileName & ".bas"
Case vbext_ct_MSForm
.Item(i).Export sFileName & ".frm"
Project2.VBComponents.Import sFileName & ".frm"
Case Else
Debug.Print "Different Type"
End Select
Next
End With
End Sub
I can assure everybody because I am working on this subject for years now (I gave up several times). When the code is programmatically modified either line-based or - what my preferred approach is 1. rename, 2. delete the renamed, 3. re-import from export file, Workbook Save will crash, will say Excel closes the Workbook. In fact my approach works most of the time but since it is unpredictable I learned to live with it. In most cases the code change has already successfully been done. So I just reopen the Workbook and continue.
The code I use. I just removed all the execution trace and execution log code lines but some lines may still look a bit cryptic:
With rn_wb.VBProject
'~~ Find a free/unused temporary name and re-name the outdated component
If mComp.Exists(wb:=rn_wb, comp_name:=rn_comp_name) Then
sTempName = mComp.TempName(tn_wb:=rn_wb, tn_comp_name:=rn_comp_name)
'~~ Rename the component when it already exists
.VBComponents(rn_comp_name).Name = sTempName
.VBComponents.Remove .VBComponents(sTempName) ' will not take place until process has ended!
End If
'~~ (Re-)import the component
.VBComponents.Import rn_raw_exp_file_full_name
'~~ Export the re-newed Used Common Component
Set Comp = New clsComp ' class module provides the export files full name
With Comp
Set Comp.Wrkbk = rn_wb
.CompName = rn_comp_name
End With
.VBComponents(rn_comp_name).Export Comp.ExpFileFullName
'~~ When Excel closes the Workbook with the subsequent Workbook save it may be re-opened
'~~ and the update process will continue with the next outdated Used Common Component.
'~~ The (irregular) Workbook close however may leave the renamed components un-removed.
'~~ When the Workbook is opened again these renamed component may cause duplicate declarations.
'~~ To prevent this the code in the renamed component is dleted.
' EliminateCodeInRenamedComponent sTempName ' this had made it much less "reliablele" so I uncommented it
SaveWbk rn_wb ' This "crahes" every now an then though I've tried a lot
End With
Private Sub SaveWbk(ByRef rs_wb As Workbook)
Application.EnableEvents = False
DoEvents ' no idea whether this helps. coded in desparation. at least it doesn't harm
rs_wb.Save
DoEvents ' same as above, not executed when Excel crashes
Application.EnableEvents = True
End Sub

Saving extracted content from VBA in powerpoint as a new excel file

I'm new to coding, VBA and VBA in powerpoint, so this might be basic but I cant seem to get around it. I'm trying to extract some text from powerpoint files and store it separately in a new file. I found a code online that helps me output the required text onto a notepad file. However, I need it as an excel file. Every search online leads me to excel based VBA but I need to export from Powerpoint to Excel (and maybe do so basic formatting in it, like converting text to numbers or making a column bold). Following is the relevant/ exporting portion of my whole code. Please take a look and help thanks.
PS: I plan to compile the code as an Add-in for a few people with limited technical expertise, so If possible, I'd request a simple/straightforward solution or something that will work on any PC or version of powerpoint/excel. I've read making your code reference-dependant may require whoever runs the code to make references,etc before they are successfully able to run it.
Dim strFilename As String
Dim intFileNum As Integer
Dim PathSep As String
....Code that does the extraction from the Active Presentation....
On Error GoTo ErrorHandler
intFileNum = FreeFile
' PC-Centricity Alert!
' This assumes that the file has a .PPT extension and strips it off to make the text file name.
strFilename = ActivePresentation.Path _
& PathSep _
& Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _
& "_Titles.TXT"
Open strFilename For Output As intFileNum
Print #intFileNum, strTitles
NormalExit:
Close intFileNum
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume NormalExit
End Sub

Resources