I am creating a series of files automatically, although these files are yet only drafts I have to show them to relevant managers. So I want to be sure that they understand files they get are only first drafts.
I tried to include code into "Open, Workbook" event for each new created file using code from http://www.cpearson.com/Excel/VBE.aspx to show messagebox with some warning for the managers:
Sub CreateEventProcedure(wb, code)
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = wb.VBProject
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CreateEventProc("Open", "Workbook")
LineNum = LineNum + 1
.InsertLines LineNum, " MsgBox " & DQUOTE & code & DQUOTE
End With
End Sub
When I am running the script I see, while the screen is updating or during debugging, that it creates the code correctly without an error...However when i open any of the newly created files the code is not there (i.e. the messagebox is not shown when the file is opened). Just fyi, I save files as .xlsm (macro-enabled)
wb.SaveAs Filename:=file_path, FileFormat:=xlOpenXMLWorkbookMacroEnabled
My tip is that somehow the files are saved without a VBA part...
Can you please help me?
So your file doesnt contain any vba code at all? I think you are overcomplicating it or im just missing the intention but I always just use something like:
Private Sub Workbook_Open()
MsgBox "oi managers this is a draft"
End Sub
Related
I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.
You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub
I have a user who needs to execute a macro after an Excel file was opened, and who needs to know (programatically) if the current Excel file's Private Sub Workbook.open() routine is empty.
Is there any way to keep this information in memory after the workbook is opened so that if the user needs to run his macro this information is available. Something along a persistent global var would be ideal. But i'm not sure if it's possible.
Thanks!
This code below (inside a regular module) loops through all the VB Project components (including ThisWorkbook module), and checks if the module name is "ThisWorkbook".
Once it finds "ThisWorkbook" module, it checks the total number of code lines inside that module, if it's 0, it raises a MsgBox that it's empty. If it's not, then it checks to see if it can find a "Workbook_Open" string inside the code. If it does, it counts the total number of lines (not empty lines) of code between the "Workbook_Open" line and the closest "End Sub" line.
Check_WorkBookModule_Contents Code
Option Explicit
Sub Check_WorkBookModule_Contents()
Const PROC_NAME = "ThisWorkbook"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim i As Long, j As Long, SubLinesCount As Long
Dim ModuleCodeLinesCount As Long
Set VBProj = ActiveWorkbook.VBProject
' loop through all modules, worksheets and other objects in VB Project
For Each VBComp In VBProj.VBComponents
Set CodeMod = VBComp.CodeModule
Debug.Print CodeMod.Name ' <-- for debug
If CodeMod.Name Like PROC_NAME Then ' <-- check if module name is "ThisWorkbook"
' if total of code lines in "ThisWorkbook" module is empty
If CodeMod.CountOfLines = 0 Then
MsgBox CodeMod.Name & " module is empty"
Exit Sub
End If
SubLinesCount = 0 ' reset counter
' loop through all code lines inside current module
For i = 1 To CodeMod.CountOfLines
If Len(CodeMod.Lines(i, 1)) > 0 Then
' if the name of current sub is found within the current code line
If CodeMod.Lines(i, 1) Like "*Workbook_Open*" Then
For j = i + 1 To CodeMod.CountOfLines
If Len(CodeMod.Lines(j, 1)) > 0 And Not CodeMod.Lines(j, 1) Like "End Sub*" Then
SubLinesCount = SubLinesCount + 1
End If
Next j
If SubLinesCount > 0 Then
MsgBox CodeMod & " module, has an event of 'Workbook_Open' , with total of " & SubLinesCount & " lines of code"
Exit Sub
Else
MsgBox CodeMod & " module, has an event of 'Workbook_Open' , but it's empty !"
Exit Sub
End If
End If
End If
Next i
End If
Next VBComp
End Sub
Note: In order to access the VB Project Module, you need to follow the 2 steps below:
Step 1: Add "Trust access to the VBA project object model" , go to Developer >> Macro Security >> then add a V to the Trust access to the VBA project object model.
Step 2: Add Reference to your VB project, add "Microsoft Visual Basic for Applications Extensibility 5.3"
My workplace is rolling out some large updates for Microsoft office. I'm trying to set up a VBA macro to run on everyone's computer to create a new folder with copies of Normal.dotm so that if (God forbid) something goes wrong we can restore the Normal.dotm. This is important because EVERYONE has a different ribbon layout and different macros and settings that we don't want lost.
My problem is I have a macro that is functionally fine, however when i try it on the Normal.dotm it gives the Permission Denied error because the FileCopy funtion cant work on Normal.dotm.
Code:
Private Sub CopyFiles_Click()
sUserName = Environ$("username")
Dim BackupDir As String
BackupDir = "C:\Users\" + sUserName + "\Desktop\Backup for Normal - DO NOT DELETE"
If FileFolderExists(BackupDir) Then
Else
MkDir BackupDir
End If
If FileFolderExists("C:\Users\" + sUserName + "\AppData\Roaming\Microsoft\Templates\Normal.dotm") Then
FileCopy "C:\Users\" + sUserName + "\AppData\Roaming\Microsoft\Templates\Normal.dotm", (BackupDir + "\Normal.dotm")
End If
End Sub
I have a function for "FileFolderExists" i just didn't include it to save space (it works fine)
My question is, is there any way to work around this (Been searching for a while and have come up empty handed), or is there a better way to do this?
Try this VBScript (Not VBA)
Dim sUserName
sUserName = CreateObject("WScript.Network").UserName
Dim BackupDir
BackupDir = "C:\Users\" + sUserName + "\Desktop\Backup for Normal - DO NOT DELETE"
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
on error resume next
filesys.CreateFolder BackupDir
on error goto 0
filesys.CopyFile "C:\Users\" & sUserName & "\AppData\Roaming\Microsoft\Templates\Normal.dotm", (BackupDir & "\Normal.dotm")
Can we read scripts or lines of code to a module in vba? Like we have the include function in php.
For example:
We store this in Excel somewhere and call the range as xyz
line 1 of code
line 2 of code
line 3 of code
Then while running a macro we call this like
Sub my_macro()
xyz
End Sub
Basically I want to run a few lines of code repetitively but don't want to create another macro and pass the parameters.
This can be done using the Microsoft Visual Basic for Applications Extensibility 5.3 (VBIDE) library. There's some great examples at CPearson.com. I typically use this to insert snippets of code while I'm developing. I would personally be uncomfortable executing code stored in an excel sheet, but I tested this and it does work.
My worksheet:
A
1 MsgBox "I'm a test."
2 MsgBox "So am I."
I set up an empty subroutine that we will then insert into from the excel sheet.
Private Sub ProcToModify()
End Sub
And the subroutine that will actually insert the code into ProcToModify:
Sub ModifyProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1") ' specify module to modify
Set CodeMod = VBComp.CodeModule
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Set ws = ThisWorkbook.ActiveSheet 'change this accordingly
Set rng = ws.Range("A1:A2") 'and this
For Each cell In rng
ProcName = "ProcToModify"
With CodeMod
StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
.InsertLines StartLine + NumLines - 2, cell.Value 'insert each line at the end of the procedure to get them in the correct order.
End With
Next cell
End Sub
Called at runtime like this:
Public Sub main()
ModifyProcedure
ProcToModify
End Sub
One Big Gotchya:
Before running this code, you need to go to Excel>>File>>Options>>Trust Center>>Trust Center Settings>>Macro Settings and check the "Trust access to the VBA project object model".
I would imagine that's because allowing access to the project object is a fairly concerning security risk.
From the cpearson.com site I linked to earlier:
CAUTION: Many VBA-based computer viruses propagate themselves by
creating and/or modifying VBA code. Therefore, many virus scanners may
automatically and without warning or confirmation delete modules that
reference the VBProject object, causing a permanent and irretrievable
loss of code. Consult the documentation for your anti-virus software
for details.
Is it possible to write something like global event listener? I would like to have a listener for more objects (TextBox, CheckBox, OptionButton, Label, ...). and have the listener in my class. I have some normal events, so I my idea looks like this:
Public WithEvents eventGlobLst As <DontKnowWhat>SomeType</DontKnowWhat>
Sub setListener(controlObj As SomeType)
Set eventGlobList = controlObj
End Sub
From my run-method I'm calling sub which sets the listener
For Each pages In csDialgog.MultiPage.Pages
For Each objectControl In pages.Controls
Set eventClass = New ControlsClass
eventClass.setListener objectControl
universalObjectCollection.Add eventClass
Next
Next
This works fine with classic events. Finally I have some event handler:
Private Sub EventGlobLstnr_AfterUpdate()
Functions.GlobalChange
End Sub
I would like to know if exist some ancestor of all objects which I can use. Or I must write the listener for every type separately and set them same GlobalChange.
The answer is no, you're probably better off with self-writing code. Here's a good link that allows you to write into VBA editor
Programming the VBA editor - Chip Pearson
This code was taken from Chip Pearson:
Creating An Event Procedure
This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used. CreateEventProc will create the declaration line and the end of procedure line. It returns the line number on which the event procedure begins.
Sub CreateEventProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CreateEventProc("Open", "Workbook")
LineNum = LineNum + 1
.InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE
End With
End Sub
Using .CreateEventProc, you can create an event for each elements that you want to "catch"
I believe this is the only way of achieving the goal you want.
Cheers,
kpark