I want to check three different textboxes on a form (but not all) to see if any are left blank. Comparable to "If IsBlank," on the spreadsheet. From what I've read, it seems that IsEmpty can't be used this way? I've been playing with IsNull, but haven't found a proper syntax that would allow it to work. Surely there must be some simple, even standard, way of doing this? Maybe some other function I've never heard of?
(I know I can use If Txtbx1.value = "" Or If... (etc.)
—I'm looking for a shorter and more graceful way to do this.)
Thanks!
Consider using OR:
Sub dural()
If Txtbx1.Value = "" Or Txtbx2.Value = "" Or Txtbx3.Value = "" Then
MsgBox "at least one empty"
End If
End Sub
Match vs Array of Text Boxes feat. IsError, VarType and TypeName
All codes were in a user form code sheet and were run via command buttons on the user form where also the three text boxes were located.
In the first code, the result of Match is passed to the var (variant) variable and further evaluated. If there is at least one text box with no value ("" or vbNullString), var will return the position of the first found empty text box 1-based i.e. the first is 1, the second is 2 etc. unlike the Array which is 0-based i.e. the first element is 0, the second is 1 etc.
The second code is a presentation of the three choices that were studied in the first code.
The third code is a 'bad' code without variables you might be looking for.
Sub TextBoxFun()
Dim vntTB As Variant ' Text Box Array
Dim var As Variant ' Match Variant
Dim strTB As String ' Pass String
Dim lngTB As Long ' Pass Long
' Pass TextBoxes to Text Box Array.
vntTB = Array(TextBox1, TextBox2, TextBox3)
' Either:
var = Application.Match("", vntTB, 0)
' Or:
'var = Application.Match(vbNullString, vntTB, 0)
Debug.Print String(10, "'")
Debug.Print "IsError(var) = " & IsError(var) ' True
Debug.Print "VarType(var) = " & VarType(var) ' 10 or vbError
Debug.Print "TypeName(var) = " & TypeName(var) ' Error
Debug.Print String(10, "'")
' Line of Code / vbNullString Found ? >>> ' True False
Debug.Print var ' 1
' Depending on the first position of ' 2
' the found vbNullString or "". ' 3 Error 2042
lngTB = IsError(var): Debug.Print lngTB ' 0 -1
lngTB = VarType(var): Debug.Print lngTB ' 5 10
'lngTB = TypeName(var): Debug.Print lngTB ' Nope Nope
' TypeName returns always a string.
strTB = IsError(var): Debug.Print strTB ' False True
strTB = VarType(var): Debug.Print strTB ' 5 10
strTB = TypeName(var): Debug.Print strTB ' Double Error
End Sub
Sub TextBoxFunConclusion()
Dim vntTB As Variant ' Text Box Array
' Pass TextBoxes to Text Box Array.
vntTB = Array(TextBox1, TextBox2, TextBox3)
If IsError(Application.Match("", vntTB, 0)) Then
Debug.Print "No 'empty' text boxes (via IsError)."
Else
Debug.Print "At least one 'empty' text box (via IsError)."
End If
If VarType(Application.Match("", vntTB, 0)) = 10 Then
Debug.Print "No 'empty' text boxes (via VarType)."
Else
Debug.Print "At least one 'empty' text box (via VarType)."
End If
If TypeName(Application.Match("", vntTB, 0)) = "Error" Then
Debug.Print "No 'empty' text boxes (via TypeName)."
Else
Debug.Print "At least one 'empty' text box (via TypeName)."
End If
End Sub
Sub TextBoxFunMyChoice()
If IsError(Application.Match("", Array(TextBox1, TextBox2, TextBox3), 0)) _
Then
Debug.Print "No 'empty' text boxes (via IsError)."
Else
Debug.Print "At least one 'empty' text box (via IsError)."
End If
End Sub
Private Sub CommandButton1_Click()
TextBoxFun
End Sub
Private Sub CommandButton2_Click()
TextBoxFunConclusion
End Sub
Private Sub CommandButton3_Click()
TextBoxFunMyChoice
End Sub
Related
Translate formula quotation marks incl. replacements into VBA-readable formulae
I was inspired to write this post by the recent question of
formula substitution using a constant.
At the same time, the frequent problem emerged that quotation marks
within a formula string should be replaced by double quotation marks in order
to make them readable in VBA.
Practical use case
A practical use case is to copy a table formula directly from a SO website
and "translate" it into a string-readable format.
But how is this supposed to be done with VBA means, since the direct input of
such an incomplete formula string in a procedure code without manually
added double quotation marks would immediately lead to an error?
Another feature would be to make replacements at certain points within
a formula template, for example with a constant or even with several
numerically identifiable markers.
I found a quick & dirty solution (without error handling) by analyzing a FormulaContainer procedure containing
exclusively outcommented formulae as these would allow any prior direct code input.
In order to distinguish them from the usual commentaries,
I decided with a heavy heart to use the Rem prefix (i.e. Remark) as an alternative, which we may still be familiar with from ancient Basic times.
My intention is not to show a perfect solution, but to stimulate further solutions
by demonstrating a possible way.
Question
Are there other work arounds allowing to copy tabular formulae with quotation marks directly and as possible replacement pattern into VBA procedures?
///////////////////////////////////
Main function QuickFormula()
References a FormulaContainer procedure containing exclusively formulae with Rem prefixes, such as e.g.
Sub FormulaContainer()
Rem =....
Rem =....
End Sub
This allows formula inputs with quotation marks similar to tabular cell inputs;
furthermore these inputs may contain string identifiers facilitating wanted replacements.
Option Explicit
'Site: https://stackoverflow.com/questions/70399681/how-many-quotes-to-put-around-a-formula-that-is-sending-an-empty-string
'Auth: https://stackoverflow.com/users/6460297/t-m
Function QuickFormula(ByVal no As Long, ParamArray repl() As Variant) As String
'Purp: - change indicated code line in FormulaContainer to code readable string and
' - replace enumerated identifiers with given value(s)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'1) get REMark code line indicated by ordinal argument no
QuickFormula = getCodeLine("modFormula", "FormulaContainer", no)
'2a)replace "#" identifyer(s) with constant repl value
If Not IsArray(repl(0)) Then
QuickFormula = Replace(QuickFormula, "{1}", "#")
QuickFormula = Replace(QuickFormula, "#", repl(0))
If Len(QuickFormula) = 0 Then QuickFormula = "Error NA!"
Debug.Print no & " ~~> " & Chr(34) & QuickFormula & Chr(34)
Exit Function
End If
'2b)replace 1-based "{i}" identifiers by ParamArray values
Dim i As Long
For i = LBound(repl(0)) To UBound(repl(0))
QuickFormula = Replace(QuickFormula, "{" & i + 1 & "}", repl(0)(i))
Next
'3) optional display in immediate window
Debug.Print no & " ~~> " & Chr(34) & QuickFormula & Chr(34)
End Function
Help function getCodeLine()
Gets a given code line of the indicated procedure
Function getCodeLine(ByVal ModuleName As String, ByVal ProcedureName As String, Optional ByVal no As Long = 1) As String
'Purp: return a code line in given procedure containing "Rem "
'Note: assumes no line breaks; needs a library reference to
' "Microsoft Visual Basic for Applications Extensibility 5.3"
Const SEARCH As String = "Rem =", QUOT As String = """"
'1) set project
Dim VBProj As Object
Set VBProj = ThisWorkbook.VBProject
If VBProj.Protection = vbext_pp_locked Then Exit Function ' escape locked projects
'2) set component
Dim VBComp As Object
Set VBComp = VBProj.VBComponents(ModuleName)
Dim pk As vbext_ProcKind
'3) get no + 3 top code line(s)
With VBComp.CodeModule
'a)count procedure header lines
Dim HeaderCount As Long: HeaderCount = .ProcBodyLine(ProcedureName, pk) - .ProcStartLine(ProcedureName, pk)
'b) get procedure code
Dim codelines
'codelines = Split(.Lines(.ProcBodyLine(ProcedureName, pk), .ProcCountLines(ProcedureName, pk) - HeaderCount), vbNewLine)
codelines = Split(.Lines(.ProcBodyLine(ProcedureName, pk), no + 1), vbNewLine)
'c) filter code lines containing "Rem" entries
codelines = Filter(codelines, SEARCH, True)
End With
'4) return (existing) codeline no
If no - 1 > UBound(codelines) Then Exit Function ' check existance
getCodeLine = Replace(Replace(codelines(no - 1), QUOT, String(2, QUOT)), "Rem =", "=")
End Function
Example call
References all three formulae in the FormulaContainer (including an example of a non-existing number):
Sub EnterFormula()
With Sheet1.Range("X1") ' << change to any wanted target range
.Offset(1).Formula2 = QuickFormula(1, 6)
.Offset(2).Formula2 = QuickFormula(2, Array(10, 20, 30))
'two single argument inputs with same result
.Offset(3).Formula2 = QuickFormula(3, Array(17))
.Offset(4).Formula2 = QuickFormula(3, 17)
'not existing formula number in Rem code container
.Offset(5).Formula2 = QuickFormula(333, 17)
End With
End Sub
Example FormulaContainer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Purp: formula container to be adjusted to code readable strings
'Note: Insert only Formulae starting with "Rem "-prefix!
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' # identifies constant replacement(s)
' {i} stands for enumerated replacements {1},{2}..{n}
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub FormulaContainer()
Rem =IF($V#>0,IF($G#>$S#,($S#-$H#)*$K#+$Y#,($G#-$H#)*$K#+$Y#),"")
Rem =A{1}*B{3}+C{2}
Rem =A{1}+100
End Sub
Example output in immediate window
1 ~~> "=IF($V6>0,IF($G6>$S6,($S6-$H6)*$K6+$Y6,($G6-$H6)*$K6+$Y6),"""")"
2 ~~> "=A10*B30+C20"
3 ~~> "=A17+100"
3 ~~> "=A17+100"
333 ~~> "Error NA!"
Keep it simple stupid
Assuming either the currently selected cell formula or a textbox input, a simple Userform might act as a formula translator into a line of VBA code:
Basic Userform code
Needed: TextBox1, TextBox2, CommandButton1
Option Explicit
Private Sub CommandButton1_Click()
'Purp: Redouble inside quotation marks
Const Quot As String = """"
Dim assignTo As String
assignTo = "ws.Range(""" & Selection.Address(False, False) & """).Formula2 = "
Me.TextBox2.Text = assignTo & Quot & Replace(Me.TextBox1.Text, Quot, String(2, Quot)) & Quot
End Sub
Private Sub UserForm_Initialize()
'Purp: assume active formula as wanted input
Me.TextBox1 = Selection.Formula2
End Sub
Private Sub UserForm_Layout()
'Purp: example layout textboxes
'a) define textboxes
Dim textboxes() As String
textboxes = Split("Textbox1,Textbox2", ",")
'b) format
Dim i As Long
For i = 0 To UBound(textboxes)
With Me.Controls(textboxes(i))
.Font.Name = "Courier New"
.Font.Size = 12
.MultiLine = True
.EnterKeyBehavior = True
End With
Next i
End Sub
Possible extensions
Of course you might add an insertion routine (inserting e.g. {} brackets) as well as some replacement procedures like in my workaround above.
Just for fun, a basic insertion routine here:
Private Sub CommandButton2_Click()
'Purp: Insert brackets {}
With Me.TextBox1
.SetFocus
If InsertAtCursor("{}", Me.TextBox1) Then
.SelStart = .SelStart - 1
End If
End With
End Sub
Public Function InsertAtCursor(s As String, ctrl As MSForms.Control, Optional ErrMsg As String) As Boolean
'Purpose: Insert the characters at the cursor in the active control.
'Site: http://allenbrowne.com/func-InsertChar.html
'Return: True if characters were inserted.
'Arguments: s = the character(s) you want inserted at the cursor.
' ErrMsg = string to append any error messages to.
'Note: Control must have focus.
On Error GoTo Err_Handler
Dim prior As String 'Text before the cursor.
Dim after As String 'Text after the cursor.
Dim cnt As Long 'Number of characters
Dim iSelStart As Long 'Where cursor is.
Dim txt As String 'text with LineFeeds only
If s <> vbNullString Then
With ctrl ' --> UserForm Control
txt = Replace(.Text, vbCrLf, vbLf) ' LineFeeds only (MultiLine)
If .Enabled And Not .Locked Then
cnt = Len(txt) ' Zählung ohne vbCr's !
'SelStart can't cope with more than 32k characters.
If cnt <= 32767& - Len(s) Then
'Remember characters before cursor.
iSelStart = .SelStart
If iSelStart > 1 Then
prior = Left$(txt, iSelStart)
End If
'Remember characters after selection.
If iSelStart + .SelLength < cnt Then
after = Mid$(txt, iSelStart + .SelLength + 1) ' OP:2
End If
'Assign prior characters, new ones, and later ones.
.value = prior & s & after
'Put the cursor back where it as, after the new ones.
.SelStart = iSelStart + Len(s)
'Return True on success
InsertAtCursor = True
End If
End If
End With
End If
Exit_Handler:
Exit Function
Err_Handler:
Debug.Print Err.Number, Err.Description
Select Case Err.Number
Case 438&, 2135&, 2144& 'Object doesn't support this property. Property is read-only. Wrong data type.
ErrMsg = ErrMsg & "You cannot insert text here." & vbCrLf
Case 2474&, 2185& 'No active control. Control doesn't have focus.
ErrMsg = ErrMsg & "Cannot determine which control to insert the characters into." & vbCrLf
Case Else
ErrMsg = ErrMsg & "Error " & Err.Number & ": " & Err.Description & vbCrLf
End Select
Resume Exit_Handler
End Function
I have multiple textboxes on multiple userforms that are for time allocations. For simplicity say userform1 & userform2, with textbox1 & textbox2 on each.
Userform1 is for user input, which places values into a table and userform2 pulls the values from this table and displays in the relevant textbox. I need to restrict both the input of these boxes and the display to the [H]:mm format where minutes cannot exceed 59 but hours can be 25+ i.e 125:59 but not 4:67
I tried a combination of code from both of these threads as well as others but can't seem to get it to work.
Excel VBA Textbox time validation to [h]:mm
Time format of text box in excel user form
eventually i just tried to manipulate user input with message boxes but this still leaves entries open to error
Sub FormatHHMM(textbox As Object)
Dim timeStr As String
With textbox
'Check if user put in a colon or not
If InStr(1, .Value, ":", vbTextCompare) = 0 And Len(.Value) > 1 Then
MsgBox "Please use HH:mm Format"
textbox.Value = ""
textbox.SetFocus
Else
If Right(.Value, 2) > 60 Then
MsgBox "Minutes cannot be more than 59"
textbox.Value = ""
textbox.SetFocus
End If
End If
End With
End Sub
this allows users put alpha characters in and even if correctly input when called from the table is shows as a value instead i.e 5.234... instead of 125:59
How about you split hours and minutes into two seperate input fields on the same inputbox.
So the user has to type in hours and in the next field minutes. This way you can check the input for isnumeric and >60 for seconds.
I know this is not ideal, but it would be a way to evade the given problems.
Have you tried using the Like operator? That allows checking for numeric values in each character-position. I would do it like this:
Function FormatCheck(ByVal strEntered As String)
Dim correctformat As Boolean
If strEntered Like "*#:##" And IsNumeric(Mid(strEntered, 1, InStr(1, strEntered, ":", 1) - 1)) Then
If Mid(strEntered, InStr(1, strEntered, ":", 1) + 1, 999) <= 59 Then
correctformat = True
End If
End If
If Not correctformat Then FormatCheck = "Incorrect format"
End Function
This requires at least one number before the ":"
Edit: Below is a Sub version instead of using a Function. This will pop up a MsgBox like you were using originally. You could probably replace your whole FormatHHMM sub with this without any adverse effect.
Sub FormatCheck(ByVal strEntered As String)
Dim correctformat As Boolean
If strEntered Like "*#:##" And IsNumeric(Mid(strEntered, 1, InStr(1, strEntered, ":", 1) - 1)) Then
If Mid(strEntered, InStr(1, strEntered, ":", 1) + 1, 999) <= 59 Then
correctformat = True
End If
End If
If Not correctformat Then MsgBox "Incorrect format"
End Sub
i think this may be helpful:
Option Explicit
Sub test()
Dim str As String
str = TextBox.Value
'Test string lenght. Maximun lenght number 4
If Len(str) <> 4 Then
MsgBox "Enter a valid time. Proper number of digits are 4."
Exit Sub
End If
'Test if string includes only one ":"
If (Len(str) - Len(Replace(str, ":", ""))) / Len(":") <> 1 Then
MsgBox "Use only one "":"" to separate time."
Exit Sub
End If
'Test how many digits are before and after ":"
If InStr(1, str, ":") <> 2 Then
MsgBox """:"" position should be place 2."
Exit Sub
End If
'Test if number 1,3 & 4 are number
If IsNumeric(Mid(str, 1, 1)) = False Or IsNumeric(Mid(str, 1, 1)) = False Or IsNumeric(Mid(str, 1, 1)) = False Then
MsgBox "Enter number in position 1,3 and 4."
Exit Sub
End If
'Test 2 last to digits
If Right(str, 2) <= 60 Then
MsgBox "Second limit is 60."
Exit Sub
End If
End Sub
You could use regular expressions :
Sub inputTimeFormat()
Dim userInput As String
Dim strPattern As String
Dim msgBoxText As String
Dim regEx As New RegExp
Dim objRegex As Object
strPattern = "(^[0-9]+):([0-5])([0-9])$"
msgBoxText = "Insert time in HH:mm, or hit Cancel to escape"
Set objRegex = CreateObject("vbscript.regexp")
With regEx
.ignorecase = True
.Pattern = strPattern
Do
If userInput <> vbNullString Then msgBoxText = "PLEASE RETRY" & Chr(13) & msgBoxText
userInput = Application.InputBox(msgBoxText, Default:="17:01")
If userInput = "False" Then
MsgBox "User hit cancel, exiting code", vbCritical
Exit Sub
End If
Loop Until .Test(userInput)
End With
MsgBox "Format OK"
End Sub
(you need to activate regular expressions : in VBA, "Tools" > "References" > Check the box "Microsoft VBScript Regular Expressions 5.5" > "OK")
More details on How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops
I have a Userform with several textboxes and a command button. When the information is entered and submitted the information is transfered to the first empty row.
I need a code that would counta() text within 4 columns within that row. So translate =IF(IsBlank($A2),"",COUNTA(E2:H2) to VBA code to calculate after the user submitted the information.
Option Explicit
Sub test()
Debug.Print "Var 1 : "; CountRangeIf("not(A3="""")", Range("E3:H3"))
Dim testCriteria As Boolean
testCriteria = Not (Range("A3").Value = "")
Debug.Print "Var 2 : "; CountRangeIf_Var2(testCriteria, Range("E3:H3"))
End Sub
Public Function CountRangeIf(IfCriteriaString As String, CountRange As Range) As Variant
Dim resultCriteria As Boolean
CountRangeIf = "" ' Result = "" if Criteria is false
resultCriteria = Evaluate(IfCriteriaString)
With Application.WorksheetFunction
If resultCriteria Then
CountRangeIf = .CountA(CountRange)
End If
End With
End Function
Public Function CountRangeIf_Var2(IfCriteria As Boolean, CountRange As Range) As Variant
CountRangeIf_Var2 = "" ' Result = "" if Criteria is false
With Application.WorksheetFunction
If IfCriteria Then
CountRangeIf_Var2 = .CountA(CountRange)
End If
End With
End Function
Presuming we're using Sheet1
and presuming your Row # is already stored in
ThisRowNum variable
Following should be close to what you asked for
If Trim(CStr(Sheets("Sheet1").Range("A" & ThisRowNum).Value)) = "" then
xCtr = 0 ' Your formula used a null string - you can fix this
else
xCtr = WorksheetFunction.CountA(Sheets("Sheet1").Range("E" & ThisRowNum &":H" & ThisRowNum))
endif
The xCtr variable is the result
I'm having some trouble with an Excel VBA macro and was hoping you could give me some advice on how to fix it. In the code below, when a user clicks a command button, an InputBox pops up and the user inputs a number in the form XXX-XXXXXX (e.g. 111-222222). Then, the macro takes the value from the column adjacent to button and uses the input variable to replace a certain part of the adjacent column's value. However, when I tried to run the macro and input a number such as 123-456789, nothing happens. I believe it has something to do with the dash that the user inputs, however I'm not sure how to fix it. Please help!
Sub CommandButtonTitleXXXdashXXXXXX_Click()
Application.ScreenUpdating = False
On Error Resume Next
Dim n As Integer
n = Worksheets("REVISIONS").Range("D3:D17").Cells.SpecialCells(xlCellTypeConstants).Count
If n = 15 Then
If MsgBox("Title revision box full. Add manually.", vbOKOnly, "Error") = vbOK Then
Exit Sub
End If
End If
Dim rs As Integer
rs = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
Dim amount As String
Application.ScreenUpdating = True
amount = Application.InputBox("Enter case number:", "")
Application.ScreenUpdating = False
If amount = False Then
Exit Sub
Else
Dim newCell As String
newCell = Replace(Worksheets("TITLE").Range("A" & rs).Value, "XXX-XXXXXX", amount)
Worksheets("REVISIONS").Range("D17").End(xlUp).Offset(1, 0) = newCell
End If
End Sub
I would take your code to an extra step.
No need to declare amount as String. You can keep it as a Variant. Also like I mentioned in the comment above
Can your Case number be like #D1-1%#456? If not then you have an additional problem to handle ;)
See this example. I have commented the code so that you will not have a problem understanding it. Still if you do lemme know :) The other way would be to use REGEX to validate your Case ID. Let me know if you want that example as well.
Code
Sub Sample()
Dim amount As Variant
' 123-$456789 <~~ Invalid
' 123-4567890 <~~ Valid
' ABC-&456789 <~~ Invalid
' 456-3456789 <~~ Valid
amount = Application.InputBox("Enter case number:", "")
'~~> Check if user pressed cancel
If amount = False Then Exit Sub
'~~> Check if then Case ID is valid
If IsValidCaseNo(amount) Then
MsgBox amount
Else
MsgBox "Invalid case ID"
End If
End Sub
Function IsValidCaseNo(sAmount) As Boolean
Dim s As String
Dim i As Long, j As Long
s = sAmount
'
'~~> Initial basic checks
'
'~~> Check if the length is 11 characters
If Len(Trim(s)) <> 11 Then GoTo Whoa
'~~> Check if the string contains "-"
If InStr(1, s, "-") = 0 Then GoTo Whoa
'~~> Check if the 4th character is a "-"
If Mid(s, 4, 1) <> "-" Then GoTo Whoa
'~~> Loop through 1st 3 characters and check
'~~> If they are numbers
For i = 1 To 3
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case Else: GoTo Whoa
End Select
Next
'~~> Loop through last 6 characters and check
'~~> If they are numbers
For i = 5 To 11
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case Else: GoTo Whoa
End Select
IsValidCaseNo = True
Next
Whoa:
End Function
If you Dim amount as String, you can test it as a string:
Sub GetDash()
Dim amount As String
amount = Application.InputBox(Prompt:="Enter case number", Type:=2)
If amount = "False" Then
MsgBox "You cancelled"
End If
End Sub
Context:
A PowerPoint slide in C# has a property Slide.Name (usually contains an arbitrary string value).
In my C# application I would like to use this property to identify slides (the slide order is to unreliable).
Question:
How can I manually set the Slide.Name property in the PowerPoint Application?
My problem is very like to the: “How to name an object within a PowerPoint slide?” but just on the slide level.
Any help would be appreciated.
There is no built-in functionality in PowerPoint that allows you to edit the name of a slide. As Steve mentioned, you have to do it using VBA code. The slide name will never change due to inserting more slides, and it will stay the same even if you close PowerPoint; the slide name set in VBA code is persistent. Here's some code I wrote to allow you to easily view the name of the currently selected slide and allow you to rename it:
'------------------------------------------------------------------
' NameSlide()
'
' Renames the current slide so you can refer to this slide in
' VBA by name. This is not used as part of the application;
' it is for maintenance and for use only by developers of
' the PowerPoint presentation.
'
' 1. In Normal view, click on the slide you wish to rename
' 2. ALT+F11 to VB Editor
' 3. F5 to run this subroutine
'------------------------------------------------------------------
Sub NameSlide()
Dim curName As String
curName = Application.ActiveWindow.View.Slide.name
Dim newName As String
retry:
newName = InputBox("Enter the new name for slide '" + curName + "', or press Cancel to keep existing name.", "Rename slide")
If Trim(newName) = "" Then Exit Sub
Dim s As Slide
' check if this slide name already exists
On Error GoTo SlideNotFound
Set s = ActivePresentation.Slides(newName)
On Error GoTo 0
MsgBox "Slide with this name already exists!"
GoTo retry
Exit Sub
SlideNotFound:
On Error GoTo 0
Application.ActiveWindow.View.Slide.name = newName
MsgBox "Slide renamed to '" + newName + "'."
End Sub
You can't manually set the slide name, but with a bit of code, it's simple. In VBA, for example:
Sub NameThatSlide()
ActivePresentation.Slides(1).Name = "Whatever You Like Here"
End Sub
You can rename a slide manually or with VBA. Once you know how, the door opens to some interesting possibilities, which I will demonstrate with code below.
Manually renaming slides. This ability is hidden in the VBA Editor's Properties pane, but it does not require coding.
If the Developer ribbon is not visible, enable it: File > Options > Customize Ribbon > check the Developer Main Tab.
From the Developer ribbon, click the Visual Basic menu item to open the Visual Basic Editor.
Press the Ctrl+R keys to navigate to the Project Explorer pane.
Expand "Microsoft PowerPoint Objects"
Click on any slide to select it.
Press the F4 key to navigate to the Properties pane.
Edit the (Name) item, and press Enter to apply the name change.
The slide name change may not appear immediately in the VBA Project Explorer pane. As long as the name is correct in the Properties pane, the name changed successfully.
This VBA code will also do the trick (hide slide number 1):
ActivePresentation.Slides(1).SlideShowTransition.Hidden = msoTrue
This code block covers a few ways to manage slide names and answers the main question.
Option Explicit
Public Function RenameSlide(oldName As String, newName As String)
' RenameSlide finds slide oldName and renames it to newName.
' Arguements:
' oldName: current (old) name of existing slide
' newName: new name for slide.
'
Dim tempBool As Boolean
Dim sld As Slide
Dim RetVal(0 To 1) As String
' Check if oldName can be found.
If SlideExists(oldName) Then
Set sld = Application.ActivePresentation.Slides(oldName)
Else
RetVal(0) = 1 'Error 1
RetVal(1) = "Error 1: slide with name " & oldName & " not found. Aborting."
Exit Function
End If
' Check if this slide name newName already exists.
If SlideExists(newName) Then
RetVal(0) = 2 'Error 1
RetVal(1) = "Error 2: slide with name " & newName & " already exists. Aborting."
Exit Function
End If
' Rename the slide
'Application.ActivePresentation.Slides(oldName) = newName
Application.ActivePresentation.Slides(oldName).Select
Application.ActiveWindow.View.Slide.Name = newName 'current slide
RetVal(0) = 0 'Success
RetVal(1) = "Success: slide renamed from '" & oldName & "' to '" & newName & "'."
End Function
Public Sub SetSlideName()
' Prompt user for new name for active slide.
'
Dim oldName As String
Dim newName As String
Dim sld As Slide
Dim msg As String
' Get current name of active slide.
oldName = Application.ActiveWindow.View.Slide.Name
msg = "Enter the new name for slide '" + oldName + "'."
retry:
newName = ""
' Prompt for new slide name. Loop until a name of at least 1 character is provided.
Do While newName = ""
newName = InputBox(msg, "Rename slide")
newName = Trim(newName)
If Len(newName) = 0 Then
msg = "Try again. You must enter a slide name to continue."
ElseIf newName = oldName Or newName = Str(vbCancel) Then
Exit Sub
End If
Loop
' If an existing slide already has name newName, then
' go back and prompt user again.slide name already exists
If SlideExists(newName) Then
msg = "Slide with this name already exists!"
GoTo retry
End If
' Set the new slide name
Application.ActiveWindow.View.Slide.Name = newName
MsgBox "Slide renamed to '" + newName + "'."
End Sub
Public Function SlideExists(SlideName As String) As Boolean
Dim RetVal As Boolean
Dim sld
' Assume slide does not exist.
SlideExists = False
' Try to find slide by name.
' If we error out, the slide does NOT exist.
On Error GoTo NoSlide
Set sld = ActivePresentation.Slides(SlideName)
' If we got this far, the slide DOES exist.
SlideExists = True
Exit Function
NoSlide:
' Error setting slide objects shows
' that slides does NOT exist.
SlideExists = False
End Function
As an aside, I use the slide naming trick and a little VBA to selectively remove certain slides from printing. I added a few extra VBA macros for the sake of populating the Macros list. From any slide: Developer ribbon > Macros > Select Macro > Run button. Use this method to kick off my PresentSlide, DontPresentSlide, PrintSlide and DontPrintSlide macros. Once you have properly tagged your various slides, simply run the PrepToPresentSlides or PrepToPrintSlides macro before you present or print, respectively.
Play around with these macros a bit and read the comments. You will find that I wrote the code extensibly, so you can modify it easily for your needs.
The code below helps me to manage which slides and objects are printed and which are presented on-screen. This is particularly useful when I want to print reference slides but not cover them. It is even more useful when I have slides with animations. Animations don't usually translate print well. So, I choose not to print some animated objects at all. In fact, I can even add in substitute content for the objects to be used just for printing (hidden when presenting) - though I rarely do this. Instead, I will typically hide the animation from printing or create a slide to present and a non-animated copy of it for print. With these macros, it is easy to manage a mix and match of slides and objects for print and slides and objects for presentation. I hope you enjoy.
Option Explicit
' DontPresentSlide - run macro while on a slide you wish to skip while presenting.
' The slide name will be appended with "NoPresent". You still
' need to run PrepToPresent before presenting to hide slide.
' PresentSlide - "NoPresent" will be removed from the slide. You still
' need to run PrepToPresent before presenting to hide slide.
' PrepToPesentSlides() - Unhide slides and objects you want presented and
' hide slides and objects you do NOT want presented.
' ShowNoPressnt() - show slides and shapes marked "NoPresent"
' HideNoPresent() - hide slides and shapes marked "NoPresent"
' DontPrintSlide - run macro while on a slide you wish to skip while presenting.
' The slide name will be appended with "NoPrint". You still
' need to run PrepToPresent before presenting to hide slide.
' PrintSlide - "NoPrint" will be removed from the slide. You still
' need to run PrepToPresent before presenting to hide slide.
' PrepToPrintSlides() - Unhide slides and objects you want printed and
' hide slides and objects you do NOT want printed.
' ShowNoPrint() - show slides and shapes marked "NoPrint"
' HideNoPrint() - hide slides and shapes marked "NoPrint"
' ShowHideSlides() - Hide or Unhide slides based on slide name.
' ShowHideShapes() - Hide or Unhide shapes based on shapes name.
Public Const cjaHide = False
Public Const cjaShow = True
Public Const cjaToggle = 2
Sub ShowHideSlides(NameContains As String _
, Optional LMR As String = "R" _
, Optional ShowSlide As Integer = False)
' Show or Hide slides based on slide name.
' Arguements:
' NameContains (string):
' slides with this string will be modified.
' LMR (string): enter L, M or R to indicate
' searching the Left, Middle or Right of
' the slide name, respectively.
' ShowSlide (integer):
' Show: True (-1)
' Hide: False (0)
' Toggle: 2
'
' To show or hide slides manually:
' Right-click the slide thumbnail, then click Hide Slide
' To rename slides,
' Use this VBA: ActiveWindow.View.Slide.Name = "NewSlideName"
' Or, edit the (Name) property in the VBA Properties window.
'
Dim sldCurrent As Slide
Dim found As Boolean
found = False
LMR = Trim(UCase(LMR))
If LMR <> "L" And LMR <> "M" Then LMR = "R"
'Loop through each slide in presentation.
For Each sldCurrent In ActivePresentation.Slides
'Match shape name left, right or middle as per LMR arguement.
'ActiveWindow.View.Slide.Name or Slide.SlideNumber
found = False
If LMR = "R" And LCase(right(sldCurrent.Name, Len(NameContains))) = LCase(NameContains) Then
found = True
ElseIf LMR = "L" And LCase(left(sldCurrent.Name, Len(NameContains))) = LCase(NameContains) Then
found = True
ElseIf LMR = "M" And InStr(1, LCase(NameContains), LCase(sldCurrent.Name)) Then
found = True
End If
'If match found, then set shape visibility per ShowShape arguement.
If found Then
If ShowSlide = True Then
ActivePresentation.Slides(sldCurrent.SlideNumber).SlideShowTransition.Hidden = msoFalse
ElseIf ShowSlide = False Then
ActivePresentation.Slides(sldCurrent.SlideNumber).SlideShowTransition.Hidden = msoTrue
Else
ActivePresentation.Slides(sldCurrent.SlideNumber).SlideShowTransition.Hidden = Not ActivePresentation.Slides(sldCurrent.SlideNumber).SlideShowTransition.Hidden
End If
End If
Next 'sldCurrent
End Sub
Sub ShowHideShapes(NameContains As String _
, Optional LMR As String = "R" _
, Optional ShowShape As Integer = False)
' Show or Hide shapes/objects based on object name.
' Arguements:
' NameContains (string):
' shapes with this string will be modified.
' LMR (string): enter L, M or R to indicate
' searching the Left, Middle or Right of
' the slide name, respectively.
' ShowSlide (integer):
' Show: True (-1)
' Hide: False (0)
' Toggle: 2
'
' To show, hide and/or rename objects:
' 1. Turn on Selection Pane via: Home Ribbon >
' Select > Selection Pane.
' 2. Double-click a shape name to rename it.
' 3. Click the eye icon to the far right to show/hide a shape.
Dim shpCurrent As Shape
Dim sldCurrent As Slide
Dim found As Boolean
found = False
LMR = Trim(UCase(LMR))
If LMR <> "L" And LMR <> "M" Then LMR = "R"
'Loop through each slide in presentation.
For Each sldCurrent In ActivePresentation.Slides
With sldCurrent
'Loop through each shape on current slide.
For Each shpCurrent In .Shapes
'Match shape name left, right or middle as per LMR arguement.
found = False
If LMR = "R" And right(shpCurrent.Name, Len(NameContains)) = NameContains Then
found = True
ElseIf LMR = "L" And left(shpCurrent.Name, Len(NameContains)) = NameContains Then
found = True
ElseIf LMR = "M" And InStr(1, NameContains, shpCurrent.Name) Then
found = True
End If
'If match found, then set shape visibility per ShowShape arguement.
If found Then
If ShowShape = True Then
shpCurrent.Visible = True
ElseIf ShowShape = False Then
shpCurrent.Visible = False
Else
shpCurrent.Visible = Not shpCurrent.Visible
End If
End If
Next 'sldCurrent
End With 'sldCurrent
Next 'sldCurrent
End Sub
Sub HideNoPrint()
' Hide slides and shapes you do NOT want printed.
'
' Run this macro to hide all slides and shapes that
' end with the string "NoPrint".
' Usage. Assume you have slides that contain animations that
' make the printed slide difficult or impossible to read.
' Let's further suppose you plan to present certain slides
' but not print them.
' 1. Add the"NoPrint" suffix to any shapes that clutter
' the printed page.
' 2. Add the "NoPrint" suffix to slides you don't want to
' print.
' 3. Run this macro to hide shapes and slides.
' 4. Print the slides.
' 5. Optionally, run the ShowNoPrint() macro in preparation
' for presenting the slides.
ShowHideShapes "NoPrint", "R", False
ShowHideSlides "NoPrint", "R", False
End Sub
Sub ShowNoPrint()
' Unhide slides and shapes that were hidden
' to prevent them from being printed in handouts.
'
ShowHideShapes "NoPrint", "P", True
ShowHideSlides "NoPrint", "P", True
End Sub
Sub HideNoPressent()
' Hide objects you do NOT want to present on screen.
'
' Run this macro to hide all slides and shapes that
' end with the string "NoPresent".
'
' Usage. Assume you have slides that contain supporting material
' that you wish to provide as printed handouts but not show.
' You can manually hide those slides and objects of course. I
' prefer to use these macros.
' 1. Add the"NoPresent" suffix to any shapes that you want
' to print to handouts but not show on-screen.
' 2. Add the "NoPresent" suffix to slides you want to
' print but not display on screen, such as reference slides.
' 3. Run this macro to hide the "NoPresent" shapes and slides.
' 4. Present your slides.
' 5. Optionally, run the ShowNoPresent() macro in preparation
' for printing the slides.
'
ShowHideShapes "NoPressent", "R", False
ShowHideSlides "NoPressent", "R", False
End Sub
Sub ShowNoPresent()
' Unhide objects that were hidden to prevent them from
' being presented on screen.
'
ShowHideShapes "NoPressent", "P", True
ShowHideSlides "NoPressent", "P", True
End Sub
Sub PrepToPrintSlides()
' Unhide objects you want printed and
' hide objects you do NOT want printed.
ShowNoPresent
HideNoPrint
End Sub
Sub PrepToPresentSlides()
' Unhide objects you want presented and
' hide objects you do NOT want presented.
ShowNoPrint
HideNoPresent
End Sub
Sub DontPresentSlide()
Dim RetVal, sldName As String
sldName = Application.ActiveWindow.View.Slide.Name
If InStr(1, sldName, "NoPresent", vbBinaryCompare) = 0 Then
RetVal = RenameSlide(sldName, sldName & "-NoPresent")
End If
HideNoPresent
End Sub
Sub PresentSlide()
Dim RetVal, sldName As String, strStart As String, newName As String
'Remove the NoPresent suffix from the current slide.
'get slide name
sldName = Application.ActiveWindow.View.Slide.Name
'Unhide slide
ActivePresentation.Slides(sldName).SlideShowTransition.Hidden = msoFalse
'remove "-NoPresent" from slide name
Do
strStart = InStr(1, sldName, "-NoPresent")
If InStr(1, sldName, "-NoPresent") Then
newName = left(sldName, strStart - 1) & right(sldName, Len(sldName) - strStart - 9)
RetVal = RenameSlide(sldName, newName)
End If
sldName = Application.ActiveWindow.View.Slide.Name
Loop Until InStr(1, sldName, "-NoPresent") = 0
'remove "NoPresent" from slide name
Do
strStart = InStr(1, sldName, "NoPresent")
If InStr(1, sldName, "NoPresent") Then
newName = left(sldName, strStart - 1) & right(sldName, Len(sldName) - strStart - 8)
RetVal = RenameSlide(sldName, newName)
End If
sldName = Application.ActiveWindow.View.Slide.Name
Loop Until InStr(1, sldName, "NoPresent") = 0
End Sub
Sub DontPrintSlide()
Dim RetVal, sldName As String
sldName = Application.ActiveWindow.View.Slide.Name
If InStr(1, sldName, "NoPrint", vbBinaryCompare) = 0 Then
RetVal = RenameSlide(sldName, sldName & "-NoPrint")
End If
HideNoPrint
End Sub
Sub PrintSlide()
Dim RetVal, sldName As String, strStart As String, newName As String
'Remove the NoPrint suffix from the current slide.
'get slide name
sldName = Application.ActiveWindow.View.Slide.Name
'Unhide slide
ActivePresentation.Slides(sldName).SlideShowTransition.Hidden = msoFalse
'remove "-NoPrint" from slide name
Do
strStart = InStr(1, sldName, "-NoPrint")
If InStr(1, sldName, "-NoPrint") Then
newName = left(sldName, strStart - 1) & right(sldName, Len(sldName) - strStart - 7)
RetVal = RenameSlide(sldName, newName)
End If
sldName = Application.ActiveWindow.View.Slide.Name
Loop Until InStr(1, sldName, "-NoPrint") = 0
'remove "NoPrint" from slide name
Do
strStart = InStr(1, sldName, "NoPrint")
If InStr(1, sldName, "NoPrint") Then
newName = left(sldName, strStart - 1) & right(sldName, Len(sldName) - strStart - 6)
RetVal = RenameSlide(sldName, newName)
End If
sldName = Application.ActiveWindow.View.Slide.Name
Loop Until InStr(1, sldName, "NoPrint") = 0
End Sub
Sub HideAllCovers()
' Run this macro to hide all Covers.
ShowHideShapes "Cover", "L", False
End Sub
Sub ShowAllCovers()
' Run this macro to hide all Covers.
ShowHideShapes "Cover", "L", True
End Sub
Sub HideAllAnswers()
' Run this macro to hide all Covers.
ShowHideShapes "Answer", "L", False
End Sub
Sub ShowAllAnswers()
' Run this macro to hide all Covers.
ShowHideShapes "Answer", "L", True
End Sub
Sub HideAllQuestions()
' Run this macro to hide all Covers.
ShowHideShapes "Question", "L", False
End Sub
Sub ShowAllQuestions()
' Run this macro to hide all Covers.
ShowHideShapes "Question", "L", True
End Sub
Sub ShowAll()
' Run this macro to hide all shapes (Covers and Answers).
ShowAllQuestions
ShowAllAnswers
ShowAllCovers
ShowNoPrint
End Sub
Sub HideAll()
' Run this macro to hide all shapes (Covers and Answers).
HideAllQuestions
HideAllAnswers
HideAllCovers
HideNoPrint
End Sub
Enable the "Developer" tab in "File -> Options -> Customize Ribbon" (Details: https://www.addintools.com/documents/powerpoint/where-is-developer-tab.html)
In the developer tab, follow these steps and see the image below (in Portuguese, sorry)
Enter the developer tab
Select the target slide
If you don't have any active X control (buttons, textboxes, etc.) in the slide, add a dummy button from the developer tab
Select this button on the slide and click "properties" at the developer tab
At the top of the properties window, there is a combo box where you can select the slide instead of the button
Select the slide and see its programming properties, including name
I'm not certain that this will enable you to set the Slide.Name property because I'm not a VBA programmer, but anyway AFAIK the easiest way to name slides in PowerPoint 2010 is using Outline view.
If you position your mouse farthest left on a created slide, you can drag rightwards a kind of vertical slide sorter. At the top of that pane, you'll see two tabs: Slides and Outline.
Select Outline, you'll see each slide numbered and a grey grab button which allows you to reorder your slides. If you click to the right of that, you can type in whatever name you like, say Home.
In the main view pane, the slide will then have Home emblazoned across it. You can then either leave it there, or conceal it by altering the font colour to the background or by moving the text outside the presentation frame.
BTW You can use these names in hyperlinks.
used the Sub SplitFile() function to create individual slides from a deck of >100 slides. All went well!! But can anyone tell me what code do I use to rename the file automatically, assuming that each slide has a title in a text box? I want the slide title to be the file name for the new, individual slide created.
Here's the code I used to create individual slides (as individual files), thanks to whoever posted it online.
Sub SplitFile()
Dim lSlidesPerFile As Long
Dim lTotalSlides As Long
Dim oSourcePres As Presentation
Dim otargetPres As Presentation
Dim sFolder As String
Dim sExt As String
Dim sBaseName As String
Dim lCounter As Long
Dim lPresentationsCount As Long ' how many will we split it into
Dim x As Long
Dim lWindowStart As Long
Dim lWindowEnd As Long
Dim sSplitPresName As String
On Error GoTo ErrorHandler
Set oSourcePres = ActivePresentation
If Not oSourcePres.Saved Then
MsgBox "Please save your presentation then try again"
Exit Sub
End If
lSlidesPerFile = CLng(InputBox("How many slides per file?", "Split Presentation"))
lTotalSlides = oSourcePres.Slides.Count
sFolder = ActivePresentation.Path & "\"
sExt = Mid$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") + 1)
sBaseName = Mid$(ActivePresentation.Name, 1, InStr(ActivePresentation.Name, ".") - 1)
If (lTotalSlides / lSlidesPerFile) - (lTotalSlides \ lSlidesPerFile) > 0 Then
lPresentationsCount = lTotalSlides \ lSlidesPerFile + 1
Else
lPresentationsCount = lTotalSlides \ lSlidesPerFile
End If
If Not lTotalSlides > lSlidesPerFile Then
MsgBox "There are fewer than " & CStr(lSlidesPerFile) & " slides in this presentation."
Exit Sub
End If
For lCounter = 1 To lPresentationsCount
' which slides will we leave in the presentation?
lWindowEnd = lSlidesPerFile * lCounter
If lWindowEnd > oSourcePres.Slides.Count Then
' odd number of leftover slides in last presentation
lWindowEnd = oSourcePres.Slides.Count
lWindowStart = ((oSourcePres.Slides.Count \ lSlidesPerFile) * lSlidesPerFile) + 1
Else
lWindowStart = lWindowEnd - lSlidesPerFile + 1
End If
' Make a copy of the presentation and open it
For Each oSlide In ActiveWindow.Presentation.Slides
strTitles = strTitles _
& "Slide: " _
& CStr(oSlide.SlideIndex) & vbCrLf _
& oSlide.Shapes.Title.TextFrame.TextRange.Text _
& vbCrLf & vbCrLf
Next oSlide
On Error GoTo ErrorHandler
intFileNum = FreeFile
sSplitPresName = sFolder & sBaseName & _
"_" & CStr(lWindowStart) & "-" & CStr(lWindowEnd) & "." & sExt
oSourcePres.SaveCopyAs sSplitPresName, ppSaveAsDefault
Set otargetPres = Presentations.Open(sSplitPresName, , , True)
With otargetPres
For x = .Slides.Count To lWindowEnd + 1 Step -1
.Slides(x).Delete
Next
For x = lWindowStart - 1 To 1 Step -1
.Slides(x).Delete
Next
.Save
.Close
End With
Next ' lpresentationscount
NormalExit:
Exit Sub
ErrorHandler:
MsgBox "Error encountered"
Resume NormalExit
End Sub