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
Related
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...
I would like to save my file with the flexible name, which will change as the cell value changes.
The one answer is here:
Save a file with a name that corresponds to a cell value
however, I want also some fixed part of the name, which won't change unlike the part described in the query above.
Basing on this solution I tried to write something as follows:
Sub Save ()
Dim name As String, Custom_Name As String
name = Range("A2").Value
Custom_Name = "NBU" & name & "- Opportunity list.xlsx"
ActiveWorkbook.SaveAs Filename:=Custom_Name
In the effect, I am getting an error:
This extension cannot be used with the selected file type. Change the file extension in the File name text box or select a different type file by changing the Save as type.
I would like to have this file in the .xlsx extension.
Excel VBA - save as with .xlsx extension
The answer above doesn't really match to my situation.
It will be vital to remove all form control buttons in the newly saved file, when possible.
Thanks & Regards,
End Sub
There is no action in the routine listed to save the file. It just simply takes the contents of a cell and creates a string with wrapped values.
I am not totally sure of what your goal is, but you need to add the action from the second link you provided. Workbook.SaveAs Method.
See the code below for a working example that I created to test.
Public Sub Save()
Dim name As String, Custom_Name As String
name = Range("A2").Value
Custom_Name = ThisWorkbook.Path & "\" & "NBU" & name & " - Opportunity list.xlsx"
'Disable alert when saving
Application.DisplayAlerts = False
'Save the workbook.
ActiveWorkbook.SaveAs Filename:=Custom_Name, FileFormat:=51
End Sub
You should note that after this code has executed, you will now be in the newly created file. This is not an export.
Test this and let me know if you have any questions. There are a few things that seem to be unnecessary in your code, but we can address those if you find this answers your first issue.
Edit:
I would also call out specifically then worksheet with the range as well.
name = Worksheets("Sheet1").Range("A2")
You said the file name is 'Opportunity v1.0.xslm'. Would it have macros? My version of Excel complains about using .xlsx if there is code in the workbook.
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
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.
I'd like to use VBA to open a .tbl file in notepad (or notepad++). Basically, I have some .tbl files that I can drag and drop into notepad++ to edit, and I'd like to do that same thing through VBA. I can take care of the editing once the file is open. I just can't find anything about opening a non-txt file in notepad using VBA.
Opening in Excel destroys the formatting, so I'd like to stick with a text editor.
Thanks!
You can write a simple VBA module that invokes Notepad++:
Sub Button1_Click()
Dim res As Variant
Dim fileToOpen As String
Dim nppPath As String
fileToOpen = "F:\test.tbl"
nppPath = "F:\Program Files (x86)\Notepad++\notepad++.exe"
res = Shell(nppPath & " " & fileToOpen, vbNormalFocus)
End Sub
I don't have sufficient reputation to comment on Andrea's code (which works for me). I did want to point out one thing for the benefit of others. I encounter an error using Andrea's code unless I put in a space after .exe ". Other than that small observation mine adds nothing to Andrea's answer.
Sub OpenInNotepadPP()
Dim FullFilePath As String
FullFilePath = "C:\FilePath\FileName.txt"
Dim MyTxtFile As Variant
'Note, a single space needs to be placed after notepat++.exe "
MyTxtFile = Shell("C:\Program Files (x86)\Notepad++\notepad++.exe " & FullFilePath, vbNormalFocus)
End Sub