I'm writing code in visual studio, but I'm trying to put " within a variable. Here's my code:
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Button1.Click
Dim sb As New System.Text.StringBuilder
sb.AppendLine("#echo off")
Dim i As Integer
Randomize()
i = (Rnd() * 5) + 1
If i < 2 Then
sb.AppendLine("Start "" "%ProgramFiles%\Internet Explorer\iexplore.exe" "https://www.google.com"")
' I'm trying to put the line above with quotes in it. The quotes within the line like at ("%ProgramFiles%\Internet Explorer\iexplore.exe") must stay quotes for them to be recognized in my batch file
sb.AppendLine("echo.")
sb.AppendLine("echo.")
sb.AppendLine("echo.")
sb.AppendLine("echo WARNING!!! PROCEED WITH CAUTION")
sb.AppendLine("ping 1.1.1.1 -w -n 1")
sb.AppendLine("GoTo begin")
GoTo Save
ElseIf i >= 2 And i <= 5 Then
Label2.Text = "2-4"
Label3.Text = i
Else
Label2.Text = "5"
Label3.Text = i
End If
Save:
IO.File.WriteAllText("Xx_hi_xX.bat", sb.ToString())
End Sub
End Class
You can delimit the quotation marks by putting a backslash \ in front of them so your command becomes
sb.AppendLine("Start \"\" \"%ProgramFiles%\Internet Explorer\iexplore.exe\" \"https://www.google.com\"")
Alternatively, replace the quotation marks with chr(34) and append the strings with &
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
Its an assignment for a high school class, and I've tried so many things and looked up a lot of things, and just can't get it! The assignment is to make a magic word, whatever the user wants it to be. It's confusing but I want to learn! Any suggestions would be great! I have tried what is in the code below, but I don't know how to specify to add it to the beginning of a label, the assignment is to have a label, and have buttons that are able to add a character in a textbox to the beginning, middle, and end of a label. This is due wednesday 10/20, so please if you know anything about visual basic your help would be greatfully appreciated. thanks!
Here is what I have tried! It only adds a character of a string once to the label, but not again, this is the only code I tried to add to the beginning but have not yet tried to add to the middle and end.
Dim MagicLetter As String
Dim NewString As String
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
MagicLetter = TextBox1.Text
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
NewString = Len(Label2.Text)
NewString = Mid(MagicLetter, 1, 0)
NewString = MagicLetter.Insert(1, 0)
If MagicLetter = TextBox1.Text Then
NewString = Mid(MagicLetter, 1, 1)
End If
Label3.Text = "Magic Word: " & MagicLetter
NewString = MagicLetter & Label2.Text
The problem lies here
NewString = Len(Label2.Text)
NewString = Mid(MagicLetter, 1, 0)
NewString = MagicLetter.Insert(1, 0)
What you do here is you write 3 times into the same variable NewString so in the end only the last value NewString = MagicLetter.Insert(1, 0) is in the variable because the 2 before got overwritten by the next one. So these three lines still do the same if you delete the first 2.
Then you don't need any global variables:
Dim MagicLetter As String
Dim NewString As String
You can do it with local variables inside the Button1_Click procedure. Always use local variables over global ones if you can.
Also you don't need the TextBox1_TextChanged event because you are not interested in every change of this text box. You only want to know its content when you click the button.
So we can do everything in the Button1_Click procedure
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim OriginalText As String
OriginalText = Label3.Text ' here we get the text from the label
Dim MagicLetter As String
MagicLetter = TextBox1.Text ' here we get the magic letter from the textbox
Dim NewText As String
NewText = OriginalText ' our new text should be created from the original text
' now we add the magic letter infront
NewText = MagicLetter & NewText
' now we add the magic letter in the end
NewText = NewText & MagicLetter
' now we add the magic letter in the middle
Dim TextLength As Long
TextLength = Len(NewText) ' here we get the length of our text (we need to split it in the middle)
Dim LeftPart As String
LeftPart = Mid(NewText, 1, CLng(TextLength / 2)) ' here we get the left part of the text
Dim RightPart As String
RightPart = Mid(NewText, Len(LeftPart) + 1) ' here we get the right part of the text
' now we add the magic letter between the left and right part
NewText = LeftPart & MagicLetter & RightPart
' finall we write the new text into our label
Label3.Text = NewText
End Sub
Public Class FormMagicWord
Private Function GenerateMagicWord(MagicLetter As Char, Type As String)
'Declare the MagicWord as the label, which is set as just "Magic" in the designer
Dim MagicWord As String = LblMagicWord.Text
'Use a case statement (which is just a cleaner if/else if/else)
Select Case Type
Case "Beginning"
'Combine the MagicLetter and the MagicWord into the MagicWord string.
MagicWord = MagicLetter & MagicWord
Case "Middle"
'Set the initial "midpoint" as 0 in-case the label is empty.
Dim MidPoint As Integer = 0
'Get the middle of the MagicWord string if its length > 0. I used Math.Floor() which will round down to the nearest whole number, so if the length was 9: 9/2 = 4.5 it would round down to 4.
'Alternatively you can use Math.Ceiling() which does the opposite, it rounds up to the next whole number, so if the length was 9: 9/2 = 4.5 it would round up to 5.
'It's cast as an integer (CInt) because we only care about whole numbers for this
If MagicWord.Length > 0 Then
MidPoint = CInt(Math.Floor(MagicWord.Length / 2))
End If
'Insert the MagicLetter at the midpoint of the MagicWord string.
MagicWord = MagicWord.Insert(MidPoint, MagicLetter)
Case "End"
'Combine the MagicWord and the MagicLetter into the MagicWord string.
MagicWord = MagicWord & MagicLetter
Case Else
'Not used, but this would be the "else" equivalent for a Select/Case/Switch statement
End Select
'Return the MagicWord string
Return MagicWord
End Function
'I've changed the handler to manage all three buttons: (BtnBeginning, BtnMiddle, BtnEnd) because the logic is the same for all of them.
'I've also changed the default sender object to Btn as a button, so it explicitly knows what type of control we're handling
Private Sub BtnBeginning_Click(Btn As Button, e As EventArgs) Handles BtnBeginning.Click, BtnMiddle.Click, BtnEnd.Click
'Get the magic letter as a single character, which is all we need.
'The designer also has the max length of the TxtMagicLetter textbox set to 1
Dim MagicLetter As Char = TxtMagicLetter.Text
'Call the GenerateMagicWord function passing the arguments of the letter and the text of the button (Beginning, Middle, End) which will run through the select statement to determine how to format the string
Dim MagicWord As String = GenerateMagicWord(MagicLetter, Btn.Text)
'Finally, set the MagicWord label as the returned string
LblMagicWord.Text = MagicWord
End Sub
End Class
Here's the designer code as well so you can just copy/paste the buttons/textbox/labels.
Here's how to access the code behind the design:
View Designer Code in Visual Studio 2010
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class FormMagicWord
Inherits System.Windows.Forms.Form
'Form overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Me.TxtMagicLetter = New System.Windows.Forms.TextBox()
Me.BtnBeginning = New System.Windows.Forms.Button()
Me.BtnMiddle = New System.Windows.Forms.Button()
Me.BtnEnd = New System.Windows.Forms.Button()
Me.LbLMagicLetter = New System.Windows.Forms.Label()
Me.LblMagicWordLabel = New System.Windows.Forms.Label()
Me.LblMagicWord = New System.Windows.Forms.Label()
Me.SuspendLayout()
'
'TxtMagicLetter
'
Me.TxtMagicLetter.Location = New System.Drawing.Point(249, 12)
Me.TxtMagicLetter.MaxLength = 1
Me.TxtMagicLetter.Name = "TxtMagicLetter"
Me.TxtMagicLetter.Size = New System.Drawing.Size(246, 20)
Me.TxtMagicLetter.TabIndex = 0
'
'BtnBeginning
'
Me.BtnBeginning.Location = New System.Drawing.Point(12, 38)
Me.BtnBeginning.Name = "BtnBeginning"
Me.BtnBeginning.Size = New System.Drawing.Size(157, 33)
Me.BtnBeginning.TabIndex = 1
Me.BtnBeginning.Text = "Beginning"
Me.BtnBeginning.UseVisualStyleBackColor = True
'
'BtnMiddle
'
Me.BtnMiddle.Location = New System.Drawing.Point(175, 38)
Me.BtnMiddle.Name = "BtnMiddle"
Me.BtnMiddle.Size = New System.Drawing.Size(157, 33)
Me.BtnMiddle.TabIndex = 2
Me.BtnMiddle.Text = "Middle"
Me.BtnMiddle.UseVisualStyleBackColor = True
'
'BtnEnd
'
Me.BtnEnd.Location = New System.Drawing.Point(338, 38)
Me.BtnEnd.Name = "BtnEnd"
Me.BtnEnd.Size = New System.Drawing.Size(157, 33)
Me.BtnEnd.TabIndex = 3
Me.BtnEnd.Text = "End"
Me.BtnEnd.UseVisualStyleBackColor = True
'
'LbLMagicLetter
'
Me.LbLMagicLetter.AutoSize = True
Me.LbLMagicLetter.Location = New System.Drawing.Point(172, 12)
Me.LbLMagicLetter.Name = "LbLMagicLetter"
Me.LbLMagicLetter.Size = New System.Drawing.Size(66, 13)
Me.LbLMagicLetter.TabIndex = 4
Me.LbLMagicLetter.Text = "Magic Letter"
'
'LblMagicWordLabel
'
Me.LblMagicWordLabel.AutoSize = True
Me.LblMagicWordLabel.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.LblMagicWordLabel.Location = New System.Drawing.Point(8, 141)
Me.LblMagicWordLabel.Name = "LblMagicWordLabel"
Me.LblMagicWordLabel.Size = New System.Drawing.Size(112, 24)
Me.LblMagicWordLabel.TabIndex = 5
Me.LblMagicWordLabel.Text = "Magic Word"
'
'LblMagicWord
'
Me.LblMagicWord.AutoSize = True
Me.LblMagicWord.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.LblMagicWord.Location = New System.Drawing.Point(135, 141)
Me.LblMagicWord.Name = "LblMagicWord"
Me.LblMagicWord.Size = New System.Drawing.Size(0, 24)
Me.LblMagicWord.TabIndex = 6
Me.LblMagicWord.Text = "Magic"
'
'FormMagicWord
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(800, 450)
Me.Controls.Add(Me.LblMagicWord)
Me.Controls.Add(Me.LblMagicWordLabel)
Me.Controls.Add(Me.LbLMagicLetter)
Me.Controls.Add(Me.BtnEnd)
Me.Controls.Add(Me.BtnMiddle)
Me.Controls.Add(Me.BtnBeginning)
Me.Controls.Add(Me.TxtMagicLetter)
Me.Name = "FormMagicWord"
Me.Text = "Magic Word"
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Friend WithEvents TxtMagicLetter As TextBox
Friend WithEvents BtnBeginning As Button
Friend WithEvents BtnMiddle As Button
Friend WithEvents BtnEnd As Button
Friend WithEvents LbLMagicLetter As Label
Friend WithEvents LblMagicWordLabel As Label
Friend WithEvents LblMagicWord As Label
End Class
Dim magicWord As String = "abcdef"
Label1.Text = $"{TextBox1.Text}{String.Concat(magicWord.Take(magicWord.Length \ 2))}{TextBox1.Text}{String.Concat(magicWord.Skip(magicWord.Length \ 2))}{TextBox1.Text}"
1abc1def1
When magicWord = "abcdefg" (odd number of characters),
1abc1defg1
the inserted string is not quite in the middle, but the requirement is not clear in your question.
This doesn't include validation such as TextBox.Text should be a char, and magic word length being odd or even. Integer division \ is used to pass an integral number of characters to Take and Skip.
This may not be usable since it doesn't utilize Mid or Len, but I posted it for posterity
NewString = Len(Label2.Text)
You have a problem here Len(String) returns an Integer and you have already declared NewString As String.
NewString = Mid(MagicLetter, 1, 0)
On the very next line, you throw away the value of NewString and assign something else. This is a bit silly because Mid(string, StartIndex, Length) Since the length is 0 this gets you and empty string. Another way this is confusing is the second parameter, 1. In .net indexes for things start at 0 but this "index" starts with 1. Let's just move away from old vb6 methods and use the .net improvements.
NewString = MagicLetter.Insert(1, 0)
Again another assignment. NewString is getting tired. A funny thing about String in .net is that it is immutable (not able to be changed). Under the hood the compiler throws out the old string and creates an entirely new one everytime a string changes. Another problem with this line is the second parameter of Insert takes String. 0 is not a String, it is an Integer.
The backward slash indicate Integer Division.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim MagicLetter As String = TextBox1.Text
Dim MagicWord = "antiestablishmentarianism"
Label1.Text = MagicWord & MagicLetter
Label2.Text = MagicLetter & MagicWord
Dim WordMiddle = MagicWord.Length \ 2
Label3.Text = MagicWord.Insert(WordMiddle, MagicLetter)
End Sub
I have a multiline textbox (with enable to press the Enter key), and I want to loop through every line and get the full line text.
Please note that the textbox word wrap is enabled and if the new line created by wrapping it will be similar to new line (chr(10)), In other words, I need to grab every line of text as it display on the screen and it doesn't matter if its a new line that created by pressing the "Enter" key or just the text wrapping created a new line.
I need somthing like this pseudo code:
for each line in textbox
Debug.Pring line
next
The GetLines function creates an array where each element of the array is a line from the TextBox passed into the function. I decided to strip out control characters but if this is not desired you can easily change the logic.
Capturing the GetLines return value allows you to loop through the results:
Option Explicit
Private Sub UserForm_Initialize()
Text1.Text = "This is line 1" & vbNewLine & "This is a long line that will wrap"
End Sub
Private Sub Command1_Click()
Dim lines() As String
Dim line As Variant
lines = GetLines(Text1)
For Each line In lines
Debug.Print line
Next
End Sub
Private Function GetLines(ByVal tb As MSForms.TextBox) As String()
Dim i As Integer
Dim lc As Integer
Dim c As String
Dim lines() As String
tb.SetFocus
lc = 0
ReDim lines(0 To tb.lineCount - 1)
For i = 0 To Len(tb.Text) - 1
tb.SelStart = i
c = Mid(tb.Text, i + 1, 1)
If Asc(c) >= 32 Then lines(lc) = lines(lc) & c
If tb.CurLine > lc Then lc = lc + 1
Next
GetLines = lines
End Function
For the part where the user presses "enter", it's easy enough.
A simple Debug.Print TextBox1.Text should print it as is.
If you want ot do the pseudo code, you could go with
tbText = Split(TextBox1.Text, vbNewLine)
For Each Line In tbText
Debug.Print Line
Next
Both of these however fail to detect the wordwrap.
I got a slightly hacky approach from this question
I used the hidden textbox, to keep the code simpler.
So I created another textbox, named measure, set AutoSize = True, WordWrap = False, Visible = False
and set then font options to the same as the first textbox. And used the following code:
Dim i As Long, w As Double, num As Long, memory As String
w = TextBox1.Width
tbText = Split(TextBox1.Text, vbNewLine)
For Each Line In tbText
measure.Text = Line
If measure.Width > w Then
shorten:
memory = measure.Text
While measure.Width > w
num = InStrRev(measure.Text, " ")
measure.Text = Left(measure.Text, num - 1)
i = Len(memory) - num
Wend
Debug.Print measure.Text
measure.Text = Right(Line, i)
If measure.Width > w Then
GoTo shorten
Else
Debug.Print measure.Text
End If
Else
Debug.Print Line
End If
Next
But feel free to use any of the other methods to get the width of the text for this code, or use an approach from the Link that Tim commented.
I have a VB6 application where I want to manipulate certain parts of a string I am outputting inside a textbox.
txtPhoneNums.Text = "Home: " + strHomeNo + vbCrLf _
+ "Mobile: " + strMobileNo + vbCrLf + "Work: " + strWorkNo + vbCrLf
It's nested inside an if statement that carries out various validations. I want to be able for example, in the above snippet to highlight the word "Work" and the appended string value "strWorkNo" in red and fontweighted bold. Can I do this easily without creating multiple textboxes (and leaving the other two values as default appearance?)
Thanks.
Image added for clarity. I want the two null field strings to be red and bold.
You want to use the RichTextBox. I would recommend that you don't try to mess around with the rich text format (RTF) itself, but instead use the standard methods.
Your code would be changed as follows:
Option Explicit
Private Sub Command1_Click()
WritePhoneNums "01020239", "07749383", "0234394349"
End Sub
Private Sub WritePhoneNums(ByRef strHomeNo As String, ByRef strMobileNo As String, ByRef strWorkNo As String)
Dim nPosBeginningOfWorkNo As Long
Dim nPosCurrent As Long
txtPhoneNums.TextRTF = vbNullString ' Clear existing code.
' Clear style to default.
ApplyNormalStyle txtPhoneNums
' Enter standard text. The selection will be at the end of the text when finished.
txtPhoneNums.SelText = "Home: " + strHomeNo + vbCrLf _
& "Mobile: " + strMobileNo + vbCrLf + "Work: "
' Save the cursor position, write the work number, and then save the cursor position again.
nPosBeginningOfWorkNo = txtPhoneNums.SelStart
txtPhoneNums.SelText = strWorkNo
nPosCurrent = txtPhoneNums.SelStart
' From this information, select the preceding text, and make it "selected".
txtPhoneNums.SelStart = nPosBeginningOfWorkNo
txtPhoneNums.SelLength = nPosCurrent - nPosBeginningOfWorkNo
ApplyHighlightedStyle txtPhoneNums
' Reset the selection to the end, and reset the text style.
txtPhoneNums.SelStart = nPosCurrent
txtPhoneNums.SelLength = 0
ApplyNormalStyle txtPhoneNums
txtPhoneNums.SelText = vbCrLf
End Sub
Private Sub ApplyNormalStyle(ByRef txt As RichTextBox)
txt.SelBold = False
txt.SelColor = vbBlack
End Sub
Private Sub ApplyHighlightedStyle(ByRef txt As RichTextBox)
txt.SelBold = True
txt.SelColor = vbRed
End Sub
If you've played games you might know what I mean. How the words are spelled out letter by letter instead of the whole text being displayed kinda like pokemon or some other game.
this is what I have so far:
Dim strTitle As String = " "
If IO.File.Exists("npcCraig.txt") = False Then
outfile = IO.File.CreateText("save.txt")
End If
infile = IO.File.OpenText("npcCraig.txt")
Do Until infile.Peek = -1
strTitle = infile.Read 'reads character or should at least
lblTitle.Text = lblTitle.Text + strTitle
System.Threading.Thread.Sleep(1000)
Loop
infile.Close()
outfile.Close()
It runs but form1 doesn't show up at all because of "System.Threading.Thread.Sleep(1000)".
I tried using that as a way to delay it but that didn't work obviously.
If you can could you also tell me how to put a break in it or something so that when the user presses a key the text loads completely and the player can keep going. I'm at a lost with that.
ANY HELP AT ALL WOULD BE A AMAZING!! My textbook and the rest of the internet was of no help
My best shot is this:
Public Class Form1
Dim M As Integer = 1
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim T As String = "" + TextBox1.Text
Label1.Text = Label1.Text + Mid(T, M, 1)
M = M + 1
End Sub
'You can use any trigger here
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Timer1.Enabled = True
End Sub
End Class