When multiple PowerPoint slide numbers are entered in the input box (ex: 3, 5, 6), I want to create a macro that selects the slides of the entered number, but an error occurs.
Sub test()
Dim strresponse2 As String
Dim iresponse2 As String
strresponse2 = InputBox("page number" & vbCr & "ex) 2,4,11,5")
If IsNumeric(strresponse2) Then
iresponse2 = strresponse2
End If
ActiveWindow.Selection.Unselect
ActivePresentation.slides.Range(Array(iresponse2)).Select
'error here
'How to fix it so it doesn't get an error
'ActivePresentation.Slides.Range(Array(2, 4, 11,5)).Select
'no error
End Sub
Several issues here.
a) If you enter 2, 4, 5, the check for IsNumeric(strresponse2) will fail because the function tries to convert the whole string into one single number.
b) Array(iresponse2) will not convert the string into an array (of 3 numbers). It will convert the single string 2, 4, 5 into an string array with 1 (not 3) member.
In your case, you can use the Split-function to split the input string into an array of strings.
c) If you want to access the slides by number, the input needs to be of a numeric type, not of string (even if the strings contain numbers). You will need to convert the string array into a numeric array (if you pass a string or an array of strings as parameter, VBA will look for members with the name, not the index).
Have a look to the following piece of code and check if it does what you need - it's only half tested (as I have no Powerpoint VBA available, only Excel, but the priniple is the same)
Dim answer As String
answer = InputBox("page number" & vbCr & "ex) 2,4,11,5")
Dim pagesS() As String
pagesS = Split(answer, ",") ' Split the answer into an array of strings.
ReDim pagesN(0 To UBound(pagesS)) As Long ' Create an empty numeric array
Dim countS As Long, countN As Long
For countS = 0 To UBound(pagesS) ' Loop over all strings
If IsNumeric(pagesS(countS)) Then ' String is Numeric
Dim pageNo As Long
pageNo = Val(pagesS(countS)) ' Convert string to number
If pageNo > 0 And pageNo <= ActivePresentation.slides.Count Then
pagesN(countN) = pageNo ' When number is within valid range, copy it
countN = countN + 1 ' Count the number of valid page numbers
End If
End If
Next countS
If countN > 0 Then ' At least one number found
ReDim Preserve pagesN(0 To countN - 1) ' Get rid of unused elements
ActivePresentation.Slides.Range(pagesN).Select
End If
Related
I have a vba function in my Word macro that returns a comma separated list of numbers as a string. For example;
var = (1.5, 2, 3, 5)
How would I add them up to find the sum?
replace "," with "+" and use Evaluate formula on string. Note: Have to create reference to Excel instance which is a little heavy handed to say the least! I can't find a word equivalent of Evaluate function which seems a little odd:
Option Explicit
Public Sub test()
Dim inputStr As String, oXL As Object
inputStr = "1.5, 2, 3, 5"
With CreateObject("Excel.Application")
MsgBox .Evaluate(Replace(inputStr, ",", "+"))
.Quit
End With
End Sub
You need to split the string into a string array, convert each substring into a number using Val, CDbl, or CSng (based on your requirements) and then add the numbers.
Here's an example:
Dim inputStr As String
inputStr = "1.5, 2, 3, 5"
Dim arr() As String
arr = Split(inputStr, ",")
Dim total As Single ' Or `Double` if you need more accuracy.
For Each subStr In arr
total = total + Val(subStr) ' Use `Val` if you want to ignore non-numeric values.
'total = total + CSng(subStr) ' Use `CSng` to break when finding non-numeric values.
'total = total + CDbl(subStr) ' Use `CDbl` if you need more accuracy.
Next
MsgBox total
I am trying to use the page numbers to the right-hand side of a table of contents object in Word in some VBA code. I can access the array storing the text associated with these page numbers using GetCrossReferenceItems(wdRefTypeHeading) but cannot seem to get at the page numbers themselves. None of the GetCrossReferenceItems constants listed here seem relevant.
Is there a way to reference these page numbers? Thanks!
I'm not a "Worder" so here is what I came up to:
Function GetPagesNumber(doc As Document) As Long()
Dim i As Long
Dim myRng As Range
Dim myHeadings As Variant
With doc
Set myRng = .Content
myRng.Collapse Direction:=wdCollapseEnd
myHeadings = .GetCrossReferenceItems(wdRefTypeHeading)
ReDim pages(1 To UBound(myHeadings)) As Long
For i = 1 To UBound(myHeadings)
myRng.InsertCrossReference ReferenceType:=wdRefTypeHeading, ReferenceKind:=wdPageNumber, ReferenceItem:=i
With .Paragraphs(ActiveDocument.Paragraphs.count).Range
myRng.SetRange Start:=.Start, End:=.End - 1
End With
pages(i) = CLng(myRng.Text)
Next i
End With
myRng.Delete
GetPagesNumber = pages
End Function
to be used like follows:
Option Explicit
Sub main()
Dim myPagesNumber() As Long
myPagesNumber = GetPagesNumber(ActiveDocument) '<-- store index pages numbers in myPagesNumber
End Sub
Instead of using;
myHeadings = .GetCrossReferenceItems(wdRefTypeHeading)
You can also use;
Dim myField As Field
Set myField = ActiveDocument.TablesOfContents(1).Range.Fields(1)
myHeadings = Split(myField.Result.Text, Chr(13))
This will return an array of strings, with within the last characters of the array the page number of the heading. Use pgnr = CInt(Right(myHeadings (i), Len(myHeadings (i)) - InStrRev(myHeadings (i), Chr(9)))) to get the pagenumber.
What would be better is to first split myHeadings into rows with Chr(13) as delimiter and then split into columns with Chr(9) as delimiter.
So the whole table of contents in an array.
I have a worksheet that contains information on projects. The worksheet contains a column which contains risks for each project. There is a one-to-many relationship between a project and its risks.
Currently the risks for a projects are added to single cell and separated by a line break. I need to add sequential identifiers at the start of each risk. So for example inside a particular cell it should look like this. The sequential number should be bold if at all possible.
1).**Risk 1
2).**Risk 2
3).**Risk 3
etc.
Any suggestions on how to tackle this would be appreciated.
Here's how I'd approach it via UDF:
' Reformats a list from a simple delimitation to a numbered list
' Accepts arrays of strings for inList (allowing array formulas)
' numFormat is a standard Excel-style format string (default "0. ")
' inDelimiter is the delimiter in the input list
' outDelimiter is the delimiter for the output list
Public Function TO_NUMBERED_LIST(inList As Variant, Optional numFormat As Variant, _
Optional inDelimiter As Variant, Optional outDelimiter As Variant) As Variant
Dim i As Integer, j As Integer
' Set default parameters
If IsMissing(numFormat) Then numFormat = "0). "
If IsMissing(inDelimiter) Then inDelimiter = vbNewLine
If IsMissing(outDelimiter) Then outDelimiter = inDelimiter
If IsArray(inList) Then ' Must loop through each entry if using as an array formula
Dim outList() As Variant
ReDim outList(0 To (UBound(inList) - LBound(inList)), 1 To 1)
j = 0
For i = LBound(inList) To UBound(inList)
If IsError(inList(i, 1)) Then
outList(j, 1) = inList(i, 1)
Else
outList(j, 1) = MakeNumbered(CStr(inList(i, 1)), CStr(numFormat), CStr(inDelimiter), CStr(outDelimiter))
End If
j = j + 1
Next
TO_NUMBERED_LIST = outList
Else
TO_NUMBERED_LIST = MakeNumbered(CStr(inList), CStr(numFormat), CStr(inDelimiter), CStr(outDelimiter))
End If
End Function
' Helper function to do the actual work of splitting lists, numbering them, and recombining them
Private Function MakeNumbered(inList As String, Optional numFormat As String, _
Optional inDelimiter As String, Optional outDelimiter As String) As String
Dim i As Integer
Dim tokenArr() As String
tokenArr = Split(inList, inDelimiter)
For i = 0 To UBound(tokenArr)
tokenArr(i) = Format(i + 1, numFormat) & tokenArr(i)
Next
MakeNumbered = Join(tokenArr, outDelimiter)
End Function
I leverage some knowledge from your previous thread, like the fact that the input might be an array (and the whole function might be used in an array formula) but will only ever be 1-dimensional.
I've made this pretty general for reformatting. It can take in lists with any input delimiter (in your case, a newline) and output using any desired delimiter (in your case, still a newline). The numFormat parameter acts using the Format function and supports formats like you would commonly see in Excel. Check the documentation if you need help there.
Default parameters have already been tweaked for your example - newline as delimiter(s) and "0). " as numbering format.
You can use the Split function on each cell value to create an array of risks and then prefix each risk with the sequence id. Then you can use the Join function to put the array back into a single value to update the cell with.
Depending on how the newlines got into the cell you might need to use vbCrLf, or vbNewLine instead of vbLf in the following example code:
Option Explicit
Sub AddRiskSequence()
Dim rngRisks As Range
Dim rngCell As Range
Dim varRisks As Variant
Dim lngIndex As Long
'set range with risk values
Set rngRisks = Sheet2.Range("B2:B4")
'iterate cells in risk column
For Each rngCell In rngRisks
'split cell contents by line feed into array
varRisks = VBA.Split(rngCell.Value, vbLf)
'iterate array and add sequence ids
For lngIndex = 0 To UBound(varRisks)
varRisks(lngIndex) = VBA.CStr(lngIndex + 1) & ") " & varRisks(lngIndex)
Next lngIndex
'rejoin array and update cell value
rngCell.Value = VBA.Join(varRisks, vbLf)
Next rngCell
End Sub
Before:
After:
I am trying to add the data in the two cells of the excel sheet but even if the excel cell is of the type number it does not add up the cells. It seems that there is space infornt of the number that it does not add....image is below.
Is there a vba code to remove this space from each of the cell if its presesnt.
I have exported the excel from a pdf.
Excel will attempt to convert any value to a number if you apply an operator to it, and this conversion will handle spaces. So you can use =A1*1 or A1+0 to convert a value in A1 to a number, or something like this within a function =SUM(IFERROR(A1*1,0)).
That kind of implicit conversion automatically performs a trim(). You can also do this conversion explicitly by using the funciton N(), or NumberValue() for newer versions of Excel. However, as others have pointed out, many characters won't be automatically handled and you may need to use Substitute() to remove them. For instance, Substitute(A1,160,"") for a non-breaking space, a prime suspect because of its prevalence in html. The Clean() function can give you a shortcut by doing this for a bunch of characters that are known to be problematic, but it's not comprehensive and you still need to add your own handling for a non-breaking space. You can find the ASCII code for any specific characters that are grieving you by using the Code() function... for instance Code(Mid(A1,1,1))
Character Handling UDF
The UDF below gives flexibility to the character handling approach by allowing multiple characters to be removed from every cell in a range, and produces a result that can be used as an argument. For example, Sum(RemoveChar(A1:A5,160)) would remove all non-breaking spaces from the range being summed. Multiple characters can removed by being specified in either a range or array, for example Sum(RemoveChar(A1:A5,B1:B3)) or Sum(RemoveChar(A1:A5,{160,150})).
Function RemoveChar(R As Range, ParamArray ChVal() As Variant)
Dim x As Variant
Dim ResVals() As Variant
ReDim ResVals(1 To R.Count)
'Loop through range
For j = 1 To R.Count
x = R(j).Value2
If x <> Empty Then
'Try treating character argument as array
'If that fails, then try treating as Range
On Error Resume Next
For i = 1 To UBound(ChVal(0))
x = Replace(x, Chr(ChVal(0)(i)), "")
Next
If Err = 92 Then
Err.Clear
For Each Rng In ChVal(0)
x = Replace(x, Chr(Rng.Value2), "")
Next
End If
Err.Raise (Err)
On Error GoTo 0
'If numeric then convert to number
'so that numbers will be treated as such
'when array is passed as an argument
If IsNumeric(x) Then
ResVals(j) = Val(x)
Else
ResVals(j) = x
End If
End If
Next
'Return array of type variant
RemoveChar = ResVals
End Function
Numeric Verifying UDF
The drawback with replacing characters is that it's not comprehensive. If you want something that's more of a catch-all, then perhaps something like this.
Function GetNumValues(R As Range)
Dim c, temp As String
Dim NumVals() As Double
ReDim NumVals(1 To R.Count)
'Loop through range
For j = 1 To R.Count
'Loop through characters
'Allow for initial short-circuit if already numeric
For i = 1 To Len(R(j).Value2)
c = Mid(R(j).Value2, i, 1)
'If character is valid for number then include in temp string
If IsNumeric(c) Or c = Application.DecimalSeparator Or c = Application.ThousandsSeparator Then
temp = temp + c
End If
Next
'Assign temp string to array of type double
'Use Val() function to convert string to number
NumVals(j) = Val(temp)
'Reset temp string
temp = Empty
Next
'Return array of type double
GetNumValues = NumVals
End Function
I would like to know what I'm doing wrong...
I have a word document open (in word 2010) with three tables in it. I wanted to test basic table extraction in VBA and followed the instructions http://msdn.microsoft.com/en-us/library/office/aa537149(v=office.11).aspx.
Sub ExtractTableData()
Dim doc As Word.Document
Dim tbl As Word.Table
Dim rng As Word.Range
Dim sData As String
Dim aData1() As String
Dim aData2() As String
Dim aDataAll() As String
Dim nrRecs As Long
Dim nrFields As Long
Dim lRecs As Long
Dim lFields As Long
Set doc = ActiveDocument
Set tbl = doc.Tables(1)
Set rng = tbl.ConvertToText(Separator:=vbTab, _
NestedTables:=False)
' Pick up the delimited text into and put it into a string variable.
sData = rng.Text
' Restore the original table.
doc.Undo
' Strip off last paragraph mark.
sData = Mid(sData, 1, Len(sData) - 1)
' Break up each table row into an array element.
aData1() = Split(sData, vbCr)
nrRecs = UBound(aData1())
' The messagebox below is for debugging purposes and tells you
' how many rows are in the table. It is commented out but can
' be used simply by uncommenting it.
'MsgBox "The table contained " & nrRecs + 1 & " rows"
'Process each row to break down the field information
'into another array.
For lRecs = LBound(aData1()) To nrRecs
aData2() = Split(aData1(lRecs), vbTab)
' We need to do this only once!
If lRecs = LBound(aData1()) Then
nrFields = UBound(aData2())
ReDim Preserve aDataAll(nrRecs, nrFields)
End If
' Now bring the row and field information together
' in a single, two-dimensional array.
For lFields = LBound(aData2()) To nrFields
aDataAll(lRecs, lFields) = aData2(j)
Next
Next
End Sub
I'm getting an error at this line: ReDim Preserve aDataAll(nrRecs, nrFields), which is due to "nrFields" being set to a negative value (-1)...
No idea how the upper bound of the array is a negative value... Any help on this would be much appreciated.
I figured it out - I was trying to extract a nested table. I had to cycle through all sub-tables and extract individually. Also, I had to search for and remove ^p before extraction to retain table structure.
After I had figured it out, I noticed that the MS code sample had an error: aData2(j) should actually be aData2(lFields).
Hope this helps some other newbie!
If UBound is -1 and LBound = 0, the array is empty. You can generate an empty array as follows:
Dim EmptyArray() As String
Dim s As String
EmptyArray = Split("")
Debug.Print (UBound(EmptyArray)) ' displays -1
Debug.Print (LBound(EmptyArray)) ' displays 0
In your case I suspect you need to skip the processing if the array is empty:
aData1 = Split(...)
If (UBound(aData1) < LBound(aData1) Then
' UBound is -1 and LBound is 0, array is empty, nothing to do
Else
' Array is non-empty, do your stuff
End If
Although quite bizarre, it is possible for VARIANT SAFEARRAY to have negative lower and upper bound values for any of the dimensions. The array extent is LBound(,dimension) to UBound(,dimension).
What must be true is UBound >= LBound.
To get the array size, use UBound - LBound + 1.
It used to be convention to set the lower bound using an Option Base statement at the top of VBA code although, of course, that didn't affect arrays being returned by 3rd party libraries. Most folk used to use 1 as the lower bound.