Maybe I'm overlooking the obvious, but I cant figure out how to deal with a single result in an array.
I'm using Ken Getz ahtCommonFileOpenSave API in VBA to enable selecting multiple files, using the following code.
Private Sub btn_openfiles_Click()
Dim strFilter As String
Dim strInputFileName As String
Dim strFiles() As String
Dim a As Long
strFilter = ahtAddFilterItem(strFilter, "Images (*.PNG)", "*.PNG")
strFiles = ahtCommonFileOpenSave( _
Filter:=strFilter, _
OpenFile:=True, _
InitialDir:="T:\DTP\Programs\Default\", _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_EXPLORER + ahtOFN_ALLOWMULTISELECT)
If IsArray(strFiles) Then
For a = 0 To UBound(strFiles)
Me.test_filenames = Me.test_filenames & strFiles(a) & vbCrLf
Next a
Else
Me.test_filenames = strFiles
End If
End Sub
I know that the result is an array, because I'm setting the ahtOFN_ALLOWMULTISELECT flag. When multiple files are selected, this goes well. But if only one file is selected, an
error 13 is thrown (type mismatch on strFiles)
because the return value of ahtCommonFileOpenSave is not an array.
I may be able to force an Array type just by adding a dummy value to the array produced by ahtCommonFileOpenSave and disregard this when processing the file names in the form, but maybe there is a better solution. Anyone have a suggestion?
As I already mentioned, overlooking the obvious. Changing the variable type into variant did the trick . ahtComminFileOpenSave returns the complete array when multiple files are selected and is always a Variant type. Luuk's suggestion works too (a variant type is used by default when the variable type is omitted).
The corrected (and amended) code is like this and works like a charm!
Private Sub btn_openfiles_Click()
Dim strFilter As String
Dim strInputFileName As String
Dim varFiles As Variant
Dim a As Long
strFilter = ahtAddFilterItem(strFilter, "Images (*.PNG)", "*.PNG")
Me.test_filenames = ""
varFiles = ahtCommonFileOpenSave( _
Filter:=strFilter, _
OpenFile:=True, _
InitialDir:="T:\DTP\Programs\Default\", _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_EXPLORER + ahtOFN_ALLOWMULTISELECT)
If IsArray(varFiles) Then
For a = 0 To UBound(varFiles)
Me.test_filenames = Me.test_filenames & varFiles(a) & vbCrLf
Next a
Else
Me.test_filenames = varFiles
End If
End Sub
Related
I am working on a script which selects only the needed slicer items. I tried using .SlicerItems.Selected = True / False for selecting and deselecting but I am using an OLAP data source in which case .Selected is read-only. The slicer items are in the format of YYYYWW so 7th week of 2018 would be 201807.
I recorded a macro selecting some slicer items and this is what it gave me:
Sub Macro2()
ActiveWorkbook.SlicerCaches("Slicer_YYYYWW").VisibleSlicerItemsList = Array( _
"[Results].[YYYYWW].&[201726]", "[Results].[YYYYWW].&[201727]", _
"[Results].[YYYYWW].&[201728]", "[Results].[YYYYWW].&[201729]", _
"[Results].[YYYYWW].&[201730]", "[Results].[YYYYWW].&[201731]", _
"[Results].[YYYYWW].&[201732]", "[Results].[YYYYWW].&[201733]", _
"[Results].[YYYYWW].&[201734]", "[Results].[YYYYWW].&[201735]", _
"[Results].[YYYYWW].&[201736]", "[Results].[YYYYWW].&[201737]", _
"[Results].[YYYYWW].&[201738]", "[Results].[YYYYWW].&[201739]", _
"[Results].[YYYYWW].&[201740]", "[Results].[YYYYWW].&[201741]", _
"[Results].[YYYYWW].&[201742]", "[Results].[YYYYWW].&[201743]", _
"[Results].[YYYYWW].&[201744]", "[Results].[YYYYWW].&[201745]", _
"[Results].[YYYYWW].&[201746]", "[Results].[YYYYWW].&[201747]", _
"[Results].[YYYYWW].&[201748]", "[Results].[YYYYWW].&[201749]", _
"[Results].[YYYYWW].&[201750]", "[Results].[YYYYWW].&[201751]", _
"[Results].[YYYYWW].&[201801]", "[Results].[YYYYWW].&[201802]", _
"[Results].[YYYYWW].&[201803]")
End Sub
So I tried following this template and create an array like that. This is how far I have gotten:
Sub arrayTest()
Dim startDate As Long
Dim endDate As Long
Dim n As Long
Dim i As Long
Dim strN As String
Dim sl As SlicerItem
Dim strArr As Variant
Dim dur As Long
Dim result As String
endDate = Range("C17").Value ' endDate is the last SlicerItem to be selected
startDate = Range("G17").Value ' startDate is the first SlicerItem to be selected
dur = Range("C19").Value ' duration is the the number of SlicerItems to be selected
i = 0
ReDim strArr(dur) As Variant
With ActiveWorkbook.SlicerCaches("Slicer_YYYYWW")
' .ClearManualFilter
For n = startDate To endDate
strN = CStr(n) ' convert n to string
If n = 201753 Then ' this is needed for when the year changes
strN = CStr(201801)
n = 201801
End If
strArr(i) = """[Results].[YYYYWW].&[" & strN & "]""" ' write string into array
i = i + 1
' For Each sl In .SlicerCacheLevels(1).SlicerItems
' If sl.Name = strN Then
' sl.Selected = True
' Else
' sl.Selected = False ' this is read-only for OLAP data so it's not working
' End If
' Next
Next
MsgBox Join(strArr, ", ") ' the MsgBox returns the correct string to be applied to select the right slicer items
.VisibleSlicerItemsList = Join(strArr, ", ") ' Error 13: Type mismatch
End With
End Sub
Currently, the code gives Error 13: Type mismatch on .VisibleSlicerItemsList = Join(strArr, ", "), which is also commented. So I'm guessing that either dimensioning strArr as Variant is wrong, the data is not inserted correctly into strArr or it's just impossible to do it this way. In the case of the latest one, how should I do it?
The part commented out on lines 29-35 does not work as it gives the usual error of Application-defined or object-defined error (1004) on sl.Selected = False.
I had a similar issue to overcome. Which I resolved using the following code:
Sub show_SlicerItems()
Dim sc As SlicerCache
Dim sL As SlicerCacheLevel
Dim si As SlicerItem
Dim slicerItems_Array()
Dim i As Long
Application.ScreenUpdating = False
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Name")
Set sL = sc.SlicerCacheLevels(1)
ActiveWorkbook.SlicerCaches("Slicer_Name").ClearManualFilter
i = 0
For Each si In sL.SlicerItems
ReDim Preserve slicerItems_Array(i)
If si.Value <> 0 Then
slicerItems_Array(i) = si.Name
i = i + 1
End If
Next
sc.VisibleSlicerItemsList = Array(slicerItems_Array)
Application.ScreenUpdating = True
End Sub
You need to feed .VisibleSlicerItemsList an array, not a string. Ditch the Join.
And your strArr assignment should be like this: strArr(i) = "[Results].[YYYYWW].&[" & strN & "]" i.e. you don't need to pad it out with extra "
Edit: Out of interest, I happen to be building a commercial add-in that is effectively a Pop-up Slicer, that allows you to filter an OLAP PivotTable to show all items between a range like you are attempting to do. It also lets you filter on wildcards, crazy combinations of AND and OR, and filter on lists stored in external ranges.
Here's a screenshot of it in action. Note there is a search bar up the top that lets you use < or > together to set lower and upper limits, which is what I've done in the current Search. And you can see the result: it has correctly identified the 14 items from the PivotField that fit the bill.
All I need to do to filter the PivotTable on these is click the "Filter on selected items" option, and it does just that:
But working out how to do this - particularly given the limitations of the PivotTable object model (especially where OLAP PivotTables are concerned) was a VERY long term project, with many, many hurdles to overcome to make it work seamlessly. I can't share the code I'm afraid, as this is a commercial offering that I aim to release shortly. But I just wanted to highlight that while this is certainly possible, you are going to be biting off quite a bit if you want it to not throw errors when items don't exist.
Forget my other answer...you can use the Labels Filter to do this easily, provided the field of interest is in the PivotTable as either a Rows or Columns field. Fire up the Macro Recorder, and do the following:
...and you'll see that the PivotTable gets filtered:
...and the resulting code is pretty simple:
ActiveSheet.PivotTables("PivotTable1").PivotFields("[Table1].[YYYYWW].[YYYYWW]" _
).PivotFilters.Add2 Type:=xlCaptionIsBetween, Value1:="201726", Value2:= _
"201803"
Use this:
Sub seleciona_lojas()
Dim strArr()
Dim x As Long
Dim i As Long
For x = 2 To 262
ReDim Preserve strArr(i)
strArr(i) = "[Lojas].[Location_Cd].&[" & Planilha5.Range("B" & x).Value & "]"
i = i + 1
Next x
ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Location_Cd1").VisibleSlicerItemsList = strArr
End Sub
I've stumbled upon a compile error, but don't get what can be of the issue. When trying to chagne the symbol to an input variable ( TickerID ) I get the error, works perfectly fine otherwise when inputting e.g "yhoo" for the yahoo ticker name.
Code
Private Sub CmdBtn_Add_Click()
'---------------------------------------------------------------------------------------'
' Checks that inputted ticker name is correct and calls import class after confirmation
'---------------------------------------------------------------------------------------'
' General Variables---------'
Dim TickerID As String: TickerID = UCase(Add_Instrument.TxtBox_Instrument.Value)
'--------------------------'
'Check if input field is not empty
If TickerID = "" Or Application.WorksheetFunction.IsText(TickerID) = False Then
MsgBox "Please provide a valid ticker ID"
Exit Sub
End If
Debug.Print TickerID
'Check Ticker name exists through YQLBuilder class
Dim YQLBuilder As YQLBuilder: Set YQLBuilder = New YQLBuilder
Call YQLBuilder.TickerCheck(TickerID)
' Call ImportData(TickerID)
' MsgBox "Please check the ticker name. It is in the wrong format"
End Sub
Public Sub TickerCheck(TickerID As String)
'---------------------------------------------------------------------------------------'
' Built 2014-11-05 Allows parsing of XML data through YAHOO API YQL
' 2014-12-21: Not fully built yet, see where it can be of use
'---------------------------------------------------------------------------------------'
' General Variables---------'
Const ConnStringStart As String = "http://query.yahooapis.com/v1/public/yql?q="
Const ConnStringLast As String = "&diagnostics=true&env=store://datatables.org/alltableswithkeys"
'---------------------------'
Const ConnStringInput As String = "select * from yahoo.finance.stocks where symbol='" _
& TickerID & "'" **<----- Error here!**
Debug.Print ConnStringStart & ConnStringInput & ConnStringLast
Dim YQLNodes As MSXML2.IXMLDOMNodeList
Dim YQLReq As MSXML2.DOMDocument60
Set YQLReq = New MSXML2.DOMDocument60
YQLReq.async = False
YQLReq.Load ConnStringStart & ConnStringInput & ConnStringLast
YQLReq.setProperty "SelectionNamespaces", "xmlns:f='http://www.yahooapis.com/v1/base.rng'"
Set YQLNodes = YQLReq.SelectNodes("//CompanyName")
Dim xNode As MSXML2.IXMLDOMNode
For Each xNode In YQLNodes
Debug.Print xNode.Text
Next xNode
Debug.Print YQLNodes.Length
End Sub
The message is clear. When you declare a constant, the value you give it must be constant too. In this case, part of it is the parameter TickerId, which is variable. You cannot declare a constant with a variable value.
To solve this, I think you could just use Dim instead of Const and not make ConnStringInput a constant at all.
I'm writing a macro in Visual Basic for PowerPoint 2010. I'd like to initialize a really big list of strings like:
big_ol_array = Array( _
"string1", _
"string2", _
"string3", _
"string4" , _
.....
"string9999" _
)
...but I get the "Too many line continuations" error in the editor. When I try to just initialize the big array with no line breaks, the VB editor can't handle such a long line (1000+) characters.
Does anyone know a good way to initialize a huge list of strings in VB?
Thanks in advance!
I don't think there's a way to do what you want. But there exist some workarounds.
For example, you could load your list of strings from a file.
That example can show you a hint :
Dim value As String = File.ReadAllText("C:\file.txt")
Also, this page talks about it : Excel macros - Too many line continuations.
To expand on freelax's answer:
You could store the string values in an external text file and read the items into an array line by line. My example (untested) early binds to the Microsoft Scripting Runtime library.
Dim arr() as string
Dim fso as New FileSystemObject
Dim fl as file
Dim ts as textstrean
Dim i as long ' counter
Set fl = fso.GetFile("c:\path\to\configfile.txt")
Set ts = fl.OpenAsTextStream(ForReading)
i = 0
Do While Not ts.AtEndOfStream
Redim Preserve arr(i) 'resize the array leaving data in place
arr(i) = ts.Readline
i = i + 1
Loop
Further Reading:
FileSystemObject
File
TextStream
Reading a text file with
vba
Redim an array
Of course, you'll probably want to be smarter about resizing the array, doubling it's size when you run out of space.
An option for a workaround might be to use the Join Command, like this:
Const ARRAY_VALUES As String = _
"string1,string2," & _
"string3,string4"
Dim big_ol_array() As String
big_ol_array() = Split(ARRAY_VALUES, ",")
This would allow you to put multiple entries on each line, and then you could use multiple lines continuations.
Or, if you really want one value per line, you could just use multiple constants, like this:
Const ARRAY_VALUES1 As String = _
"string1," & _
"string2," & _
"string3," & _
"string4,"
Const ARRAY_VALUES2 As String = _
"string5," & _
"string6," & _
"string7," & _
"string8"
Const ARRAY_VALUES As String = _
ARRAY_VALUES1 & _
sARRAY_VALUES2
Of course, you could choose a different delimiter if it conflicts with your data. In cases like this I'll use a pretty rare but readable delimiter like the bullet (•), which can be typed by holding the Alt key and typing the "0149" on the number pad. Then your code would look like this:
Const ARRAY_VALUES As String = _
"string1•string2•" & _
"string3•string4"
Dim big_ol_array() As String
big_ol_array() = Split(ARRAY_VALUES, "•")
Here's some other interesting delimiters. These will all show up in the IDE (while others will just look like a box):
§ ¸ · • ¤ « » ¦ ± _ ¯ ¨ ª ¹ ² ³ ´ ° º ¿ ¡
Get rid of the line continuation character as what GSerg posted in this link if you want to keep it simple. Same link posted by Freelex actually.
Dim bigStr As String, big_ol_array() As String
bigStr = "string1"
bigStr = bigStr & "," & "string2"
bigStr = bigStr & "," & "string3"
.
.
bigStr = bigStr & "," & "string9999"
big_ol_array() = Split(bigStr, ",")
Dim BigOlArray(1 to 99999) as String
BigOlArray(1) = "String1"
BigOlArray(2) = "String2"
or to save some typing
' Keep copy/pasting the second and third lines as needed
' then all you need to change is the string
x = 1
BigOlArray(x) = "String1"
x = x+1
BigOlArray(x) = "String2"
x = x+1
BigOlArray(x) = "String3"
x = x+1
So here's the relevant snippet of my code (COPSFolder is a constant defined elsewhere):
Sub CreateReport(ByRef InfoArray() As String)
Dim BlankReport As Workbook
Dim ReportSheet As Worksheet
Dim ProjFolder As String
ProjFolder = COPSFolder & "InProgress\" & InfoArray(3)
If Not Dir(ProjFolder, vbDirectory) = vbNullString Then
Debug.Print ProjFolder
MkDir ProjFolder <-----ERROR 76 HAPPENS HERE
End If
On the line indicated, ProjFolder & "InProgress\" is an existing directory. I'm trying to create a folder within it based on a value in an array of strings.
Here's what boggles me. If I replace "InfoArray(3)" with a string (ex. "12345") it works fine, but trying to use an element in the array will throw the error. The array is defined as a string everywhere it is referenced, and there are no type mismatches elsewhere in the Module.
edit: Public Const COPSFolder As String = "\\ktch163\COPS\"
edit2: here's another weird thing - if I replace InfoArray(3) with Str(InfoArray(3)) it seems towork. What I don't get is that the value of InfoArray(3) is already defined as a string. Also, it adds a space in front of the value. I can use Right(Str(InfoArray(3)), 5) I guess, but would like to figure out what the real issue is here.
edit3: as requested, here's how InfoArray() is populated:
Public Function GetPartInfo(ByRef TextFilePath As String) As String()
'Opens text file, returns array with each element being one line in the text file
'(Text file contents delimited by line break character)
Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim Info As Variant
Dim txtstream As Object
Dim item as Variant
Debug.Print TextFilePath
Set txtstream = fso.OpenTextFile(TextFilePath, ForReading, False)
GetPartInfo = Split(txtstream.ReadAll, Chr(10))
For Each item In GetPartInfo
item = Trim(item)
Next
End Function
Later on in the code - InfoArray = GetPartInfo(File.Path). (File.Path works fine, no errors when running GetPartInfo
The problem is that you are splitting using Chr(10) This is not removing the spaces. And hence when you are calling ProjFolder = COPSFolder & "InProgress\" & InfoArray(3), you have spaces in InfoArray(3)
You have 3 options
When you are creating the array, remove the spaces there OR
When you are assigning InfoArray = GetPartInfo(File.Path), remove the spaces there OR
Change the line ProjFolder = COPSFolder & "InProgress\" & InfoArray(3) to ProjFolder = COPSFolder & "InProgress\" & Trim(InfoArray(3))
Quick question, I've got all of these statically set Public Type variables in my macro code. These are supposed to represent the values of an INI file. The way I would like it to be is that the code is all dynamic, based on what's in the INI file. So I don't need to manually update both the INI file and the code behind.
This is an outtake of the code the way it is now. This is inside it's own module:
Public Type Fields
Firstname as String
Lastname as String
Username as String
End Type
I was thinking of reading the entire section of the INI file using ReadIniSection, but it seems as though it's not possible to do this within a Public Type. Am I correct? Could it be possible to get around this somehow?
Use a Scripting.Dictionary object (set a reference to the Scripting.Runtime library).
To store:
oDict.Add keyName, keyValue
To read back:
oDict(keyName)
That's assuming you have unique key names with single values.
http://msdn.microsoft.com/en-us/library/x4k5wbx4%28v=vs.85%29.aspx
Tim
It is also possible (but maybe not advisable) to add code to a module programatically. Since VBA does not support reflection, this is the only type of "dynamic" coding there is in the language. This is useful in a pinch.
See the snippet below. The addCode sub takes a standard module's name, a Type's name, and an array containing the definition of the fields.
It first tries to delete the existing Type with the same name, and then adds the new type definition in.
Sub TestAdd()
Dim FieldArray()
FieldArray = Array( _
"Firstname As String", _
"Lastname As String", _
"Username As String" _
)
AddCode "Module2", "Fields", FieldArray
End Sub
Sub AddCode(ModuleName As String, TypeName As String, FieldArray())
Dim StartLine As Long, EndLine As Long, StartColumn As Long, EndColumn As Long, _
CodeToInsert As String
StartLine = 1: StartColumn = -1
EndLine = -1: EndColumn = -1
'Find the old type definition and remove it.
With Application.VBE.ActiveVBProject.VBComponents(ModuleName).CodeModule
'Search for the start of the type definition
If .Find("Public Type " & TypeName, StartLine, StartColumn, EndLine, EndColumn, True) Then
EndLine = EndLine + 1: StartColumn = -1: EndLine = -1: EndColumn = -1
'Found the start, now find the end of the type definition
If .Find("End Type", EndLine, StartColumn, EndLine, EndColumn, True) Then
.DeleteLines StartLine, (EndLine - StartLine) + 1
End If
End If
CodeToInsert = _
"Public Type " & TypeName & vbCrLf & _
Join(FieldArray, vbCrLf) & vbCrLf & _
"End Type"
.InsertLines StartLine, CodeToInsert
End With
End Sub