I'm writing a code to translate data from a selected cell from Portuguese to English, but I'm stuck with an error:
The translated cell is returning just "and" no matter what I write, it should translate all the words in a cell... Any ideas brilliant minds?
Here is my code:
Sub traducaobeta()
Dim translate As Object 'scritping.Dictionary
Set translate = CreateObject("Scripting.Dictionary")
translate("cadeira") = "chair"
translate("cadeiras") = "chairs"
translate("criado mudo") = "night stand"
translate("criado-mudo") = "night stand"
translate("mesa") = "table"
translate("mesas") = "tables"
translate(" e ") = " and "
' the list goes on...
Dim ptWords As String
Dim enWords As String
ptWords = LCase(activecell.Value)
For Each tempVar In translate.Keys()
enWords = Replace(Replace(CStr(tempVar), CStr(tempVar), translate(CStr(tempVar)), InStr(CStr(tempVar), CStr(tempVar))), " e ", " and ")
activecell.Offset(0, 1).Value = enWords
Next
End Sub
Anyone knows how to fix it?
I would try a loop through the words in your text instead.
The following procedure translates every word that is found in your collection and leaves other words in portuguese:
Sub traducaobeta()
Dim translate As Object 'scritping.Dictionary
Set translate = CreateObject("Scripting.Dictionary")
translate("cadeira") = "chair"
translate("cadeiras") = "chairs"
translate("criado mudo") = "night stand"
translate("criado-mudo") = "night stand"
translate("mesa") = "table"
translate("mesas") = "tables"
translate(" e ") = " and "
' the list goes on...
Dim Words As Variant
Dim I As Integer
Words = Split(LCase(ActiveCell.Value))
For I = LBound(Words) To UBound(Words)
If translate(Words(I)) <> "" Then Words(I) = translate(Words(I))
Next
ActiveCell.Offset(0, 1).Value = Join(Words)
End Sub
The error is telling you that you must use a Variant type variable in a For Each loop. You're using ptWords which is a String but the values returned from translate.Keys() are not explicit string types which causes an error.
Either declaring the variable as a variant
Dim ptWords As Variant
Or using a generic variant in your loop:
For Each tempVar In translate.Keys()
enWords = Replace(Replace(CStr(tempVar), CStr(tempVar), translate(CStr(tempVar)), InStr(CStr(tempVar), CStr(tempVar))), " e ", " and ")
activecell.Offset(0, 1).Value = enWords
Next
Should do the trick.
Note that I've explicitly cast tempVar to a string in the code using CStr() - whilst this may not always be necessary (due to implicit type conversion) it is a good practice to get into.
Related
I have a button and I pass String as parameter. If string parameter increase more that 255 characters, it doesn't get any value. If string parameter is less than 255 characters, it is working fine.
Here is my code:
Dim parameterText As String
parameterText = "First Parameter Value | Third Parameter Value | Third Parameter Value"
Dim AdviceItem As CommandBarButton
Set AdviceItem = CategoryItem.Controls.Add(msoControlButton, , , , True)
With AdviceItem
.Caption = adviceText
.Visible = True
.Parameter = strParameter
.OnAction = "myFunction"
End With
Sub myFunction()
Dim parameters() As String
ReDim parameters(3)
Dim parameterText As String
parameterText = Application.CommandBars.ActionControl.Parameter
'parameterText is blank if there are more than 255 characters passed from above function
MsgBox ("parameterText" & parameterText)
parameters() = Split(parameterText, "|")
End Sub
Can anybody suggest me how to achieve it?
Assuming that there is a limitation on the .parameter, you can bypass this by using an array to store the string you want to display.
Option Explicit
Public AllParameters(100) As String
Public AllAdviceTexts(100) as String
Sub defineParameters()
AllParameters(0) = "First Parameter Value"
AllParameters(1) = "Third Parameter Value "
AllParameters(2) = "Third Parameter Value "
'etc
'set advice texts here too
End Sub
Private Sub Workbook_Open()
Dim AdviceItem As CommandBarButton
Dim i As Integer
Call defineParameters
For i = 0 To 100
Set AdviceItem = CategoryItem.Controls.Add(msoControlButton, , , , True)
With AdviceItem
.Caption = AllAdviceTexts(i)
.Visible = True
.Parameter = i
.OnAction = "myFunction"
End With
Next i
End Sub
Sub myFunction()
Dim parameterText As String
Dim index As Integer
index = Application.CommandBars.ActionControl.Parameter
parameterText = AllParameters(index)
MsgBox ("parameterText" & parameterText)
End Sub
No its not. VB string type can hold data more than 255 character.
A variable-length string can contain up to approximately 2 billion (2^31) characters
A fixed-length string can contain 1 to approximately 64K (2^16) characters.
and for SPLIT you can try like below
Dim LString As String
Dim LArray() As String
LString = "foobar.com"
LArray = Split(LString, ".")
MsgBox LArray(0)
MsgBox LArray(1)
Note: https://msdn.microsoft.com/en-us/library/6x627e5f(v=vs.90).aspx
Try to use below code if you get some idea.
Function Over255()
Dim myArray(3) As String '<<<<< not variant
myArray(0) = String(300, "a")
myArray(1) = String(300, "b")
myArray(2) = String(300, "c")
myArray(3) = String(300, "d")
'Over255 = Application.Transpose(myArray())
Over255 = TR(myArray)
End Function
'like Application.Transpose...
Function TR(arrIn) As String()
Dim arrOut() As String, r As Long, ln As Long, i As Long
ln = (UBound(arrIn) - LBound(arrIn)) + 1
ReDim arrOut(1 To ln, 1 To 1)
i = 1
For r = LBound(arrIn) To UBound(arrIn)
arrOut(i, 1) = arrIn(r)
i = i + 1
Next r
TR = arrOut
End Function
I have an array of strings (A through E) that I want to join into one string ("A B C D E"). Should I loop through the array or use the Join function?
Dim MyArray(5) as String
Dim MyString as String
MyArray(1) = "A"
MyArray(2) = "B"
MyArray(3) = "C"
MyArray(4) = "D"
MyArray(5) = "E"
Which is faster and more advisable?
This?
MyString = MyArray(1)
For i = 2 To 5
MyString = MyString & " " & MyArray(i)
Next
Or this?
MyString = Join(MyArray, " ")
For a 100k array
Sub test()
Dim aArr(1 To 100000) As String
Dim i As Long
Dim sString As String
Dim snTimer As Single
FillArray aArr
snTimer = Timer
For i = 1 To 100000
sString = sString & Space(1) & aArr(i)
Next i
Debug.Print Timer - snTimer
snTimer = Timer
sString = Join(aArr, Space(1))
Debug.Print Timer - snTimer
End Sub
Join is the clear winner
2.050781
0
the reason is that every time you concatenate with & memory has to be reallocated to accommodate the new array (which is all strings are anyway). With Join, you're just copying one array (the source array) to another array (the string) and VBA already knows the size.
If you want to combine many strings efficiently you can define a stringbuilder class.
Running the code below to build up a string of numbers up to a million takes just a fraction of a second (0.3s). Building an array and using Join takes not far off the same time (0.25s), the call to the Join function takes only about 10% of that time.
If the strings are already in an array then it makes sense to use Join but with a small number of strings the difference is unlikely to be noticeable anyway.
Sub JoinStringTest()
Dim i As Long, t As Double
Dim sb As New StringBuilder
Dim sbRet As String
Dim joinRet As String
t = Timer
For i = 1 To 1000000
sb.Append CStr(i)
Next
sbRet = sb.Text
Debug.Print "SB", Timer - t
t = Timer
Dim a(1000000) As String
For i = 1 To 1000000
a(i) = CStr(i)
Next i
joinRet = Join(a, "")
Debug.Print "Join", Timer - t
Debug.Print sbRet = joinRet
End Sub
I am not very well-versed in Reflection, but I have been working on this bit of code for a few days trying to obtain the values of class properties. I am using an API to find the values inside of cron jobs managed by the program VisualCron.
I'll explain the structure a bit. Each cron job has several tasks inside of it which have their own settings. The settings are stored in properties inside the TaskClass class that are declared like so:
Public Property <propertyname> As <classname>
Each property is tied to its own class, so for instance there is an Execute property inside TaskClass which is declared like this:
Public Property Execute As TaskExecuteClass
Inside TaskExecuteClass are the properties that hold the values I need. With the below block of code I have been able to retrieve the property values of all types EXCEPT strings. Coincidentally, the string values are the only values I need to get.
I know there must be something wrong with what I've written causing this because I can't find anyone with a similar issue after lots and lots of searching. Can anyone help me please?
Dim strAdd As String = ""
For Each t As VisualCronAPI.Server In vcClient.Servers.GetAll()
For Each f As VisualCron.JobClass In t.Jobs.GetAll
For Each s As VisualCron.TaskClass In f.Tasks
Dim propVal As Object
Dim propInfo As PropertyInfo() = s.GetType().GetProperties()
For i As Integer = 0 To propInfo.Length - 1
With propInfo(i)
If s.TaskType.ToString = propInfo(i).Name.ToString Then
Dim asm As Assembly = Assembly.Load("VisualCron")
Dim typeName As String = String.Format("VisualCron.{0}", propInfo(i).PropertyType.Name)
Dim tp As Type = asm.GetType(typeName)
Dim construct As ConstructorInfo = tp.GetConstructor(Type.EmptyTypes)
Dim classInst As Object = construct.Invoke(Nothing)
Dim classProps As PropertyInfo() = classInst.GetType().GetProperties()
For h As Integer = 0 To classProps.Length - 1
With classProps(h)
If .GetIndexParameters().Length = 0 Then
propVal = .GetValue(classInst, Nothing)
If Not propVal Is Nothing Then
strAdd = f.Name & " - " & s.Name & " - " & .Name & " - " & propVal.ToString
End If
End If
If strAdd <> "" Then
ListBox1.Items.Add(strAdd)
End If
End With
Next
End If
End With
Next
Next s
Next f
Next t
I solved my own problem, albeit in a crappy way. This is probably incredibly inefficient, but speed isn't a necessity in my particular case. Here is the code that works:
Dim strAdd As String = ""
For Each t As VisualCronAPI.Server In vcClient.Servers.GetAll()
For Each f As VisualCron.JobClass In t.Jobs.GetAll
For Each s As VisualCron.TaskClass In f.Tasks
Dim propVal As Object
Dim propInfo As PropertyInfo() = s.GetType().GetProperties()
For i As Integer = 0 To propInfo.Length - 1
With propInfo(i)
If s.TaskType.ToString = propInfo(i).Name.ToString Then
Dim asm As Assembly = Assembly.Load("VisualCron")
Dim typeName As String = String.Format("VisualCron.{0}", propInfo(i).PropertyType.Name)
Dim tp As Type = asm.GetType(typeName)
Dim construct As ConstructorInfo = tp.GetConstructor(Type.EmptyTypes)
Dim classInst As Object = construct.Invoke(Nothing)
Dim classProps As PropertyInfo() = classInst.GetType().GetProperties()
For h As Integer = 0 To classProps.Length - 1
With classProps(h)
If .GetIndexParameters().Length = 0 Then
propVal = .GetValue(CallByName(s, propInfo(i).Name.ToString, [Get]), Nothing)
If Not propVal Is Nothing Then
If propVal.ToString.Contains("\\server\") Or propVal.ToString.Contains("\\SERVER\") Then
strAdd = f.Name & " - " & s.Name & " - " & .Name & " - " & propVal.ToString
ListBox1.Items.Add(strAdd)
End If
End If
End If
End With
Next
End If
End With
Next
Next s
Next f
Next t
The piece of code that made the difference was the
classProps(h).GetValue(CallByName(s, propInfo(i).Name.ToString, [Get]), Nothing)
line.
If there are any suggestions for improving this code - I'm assuming that I've still got a lot of mistakes in here - then please comment for the future viewers of this answer and so I can adjust my code and learn more about how all of this works.
How to make a style as a bookmark in word 2010?
You won't be able to use most of the text in the document as the bookmark name. It is just illegal to use certain characters in a bookmark name in Word/VBA. It may be possible to add such characters in bookmark names in an XML format of the document, so if it is required, you can ask a separate question.
This feels like way too much code to post on SO. You really need to explain what framework you have in place and tell us where your hurdles are. We can't do this again. "Works for me". If you have any questions though don't hesitate to ask.
Run the "RunMe" macro at the bottom.
Private Function IsParagraphStyledWithHeading(para As Paragraph) As Boolean
Dim flag As Boolean: flag = False
If InStr(1, para.Style, "heading", vbTextCompare) > 0 Then
flag = True
End If
IsParagraphStyledWithHeading = flag
End Function
Private Function GetTextRangeOfStyledParagraph(para As Paragraph) As String
Dim textOfRange As String: textOfRange = para.Range.Text
GetTextRangeOfStyledParagraph = textOfRange
End Function
Private Function BookmarkNameAlreadyExist(bookmarkName As String) As Boolean
Dim bookmark As bookmark
Dim flag As Boolean: flag = False
For Each bookmark In ActiveDocument.Bookmarks
If bookmarkName = bookmark.name Then
flag = True
End If
Next
BookmarkNameAlreadyExist = flag
End Function
Private Function CreateUniqueBookmarkName(bookmarkName As String)
Dim uniqueBookmarkName As String
Dim guid As String: guid = Mid$(CreateObject("Scriptlet.TypeLib").guid, 2, 36)
guid = Replace(guid, "-", "", , , vbTextCompare)
uniqueBookmarkName = bookmarkName & guid
CreateUniqueBookmarkName = uniqueBookmarkName
End Function
Private Function BookmarkIt(rng As Range, bookmarkName As String)
Dim cleanName As String: cleanName = MakeValidBMName(bookmarkName)
If BookmarkNameAlreadyExist(cleanName) Then
cleanName = CreateUniqueBookmarkName(cleanName)
End If
ActiveDocument.Bookmarks.Add name:=cleanName, Range:=rng
End Function
''shamelessly stolen from gmaxey at http://www.vbaexpress.com/forum/showthread.php?t=37674
Private Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 58, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
MakeValidBMName = tempStr
End Function
Sub RunMe()
Dim para As Paragraph
Dim textOfPara As String
For Each para In ActiveDocument.Paragraphs
If IsParagraphStyledWithHeading(para) Then
textOfPara = GetTextRangeOfStyledParagraph(para)
If para.Range.Bookmarks.Count < 1 Then
BookmarkIt para.Range, textOfPara
End If
End If
Next
End Sub
So this is what I want to do, if it's possible.
I've got a lot of rich textboxes in a Word template. And I want to create a macro that basically checks if any characters in the text entered into the placeholder is formatted with superscript, subscript, bold or underline etc.
So, What I've got so far is this
Dim i As Long
Dim txtboxString as String
For i = 1 To ActiveDocument.ContentControls.Count
If ActiveDocument.ContentControls(i).Title = "Repporttitle" Or ActiveDocument.ContentControls(i).Title = "Subtitle" Then
If ActiveDocument.ContentControls(i).LockContentControl = True Then
ActiveDocument.ContentControls(i).LockContentControl = False
End If
txtboxString = ActiveDocument.ContentControls(i).Range.Text
End If
Next i
So, now, txtboxString contains the text that was typed into the placeholder. But I want to check each letter for it's formatting. The method above only gives me the text as a simple text string. I've seen that I can check each letter of the string this way:
Dim counter as integer
Dim contentText as string '(this is passed on via the above txtboxString)
Dim letter as string
For counter = 1 To Len(contentText)
letter = Mid(contentText, counter, 1)
Next
But, this won't give me the formatting of each letter. How can I do that?
Use Characters and Font instead of Text. Like this:
Sub GetCharacterFormatting()
Dim i As Long
Dim txtboxString As Characters ''# <- this was changed from "String" to "Characters"
Dim Bold As String
Dim Italic As String
Dim Subscript As String
Dim CharacterFont As Font
Dim ap As Document: Set ap = ActiveDocument
For i = 1 To ap.ContentControls.Count
If ap.ContentControls(i).Title = "Repporttitle" Or ap.ContentControls(i).Title = "Subtitle" Then
If ap.ContentControls(i).LockContentControl = True Then
ap.ContentControls(i).LockContentControl = False
End If
txtboxString = ap.ContentControls(i).Range.Characters ''# <- this was changed from "Text" to "Characters"
Dim counter As Integer
For counter = 1 To txtboxString.Count
Index = counter
CharacterText = txtboxString(i).Text
CharacterFont = txtboxString(i).Font
''# You can just grab all the formatting for the character or use If/Then statements
Bold = "Bold: " & CharacterFont.Bold & ", "
Italic = "Italic: " & CharacterFont.Italic & ", "
Subscript = "Subscript: " & CharacterFont.Subscript & " "
''#
Next
Debug.Print Index & " (" & CharacterText & ") : " & Bold; Italic; Subscript
End If
Next i
End Sub