Public Sub ChatMessage(ByVal sUser As String, ByVal sMessage As String)
Dim tmpData As String = sUser & ":" & vbTab & sMessage
Dim p As Paragraph = New Paragraph(New Run(tmpData))
p.Foreground = System.Windows.Media.Brushes.LightGreen
p.FontSize = 12
p.Margin = New System.Windows.Thickness(0, 0, 0, 0)
RoomMessages.RichTextBox.Document.Blocks.Add(p)
RoomMessages.RichTextBox.ScrollToEnd()
End Sub
I have added a WPF Richtextbox called RoomMessages to a Windows form.
I can add text using the code above and it works for adding text with 1 color and font. I need to be able to change the colors of words before adding them to the richtextbox. I have searched for days but no luck.
Ive seen C# code using TextRange or TextBlocks but havnt been able to get them to work in VB
tUser.Text = sUser & ":"
tUser.Foreground = New System.Windows.Media.SolidColorBrush(System.Windows.Media.Colors.LightGreen)
tMessage.Text = sMessage
tUser.Foreground = New System.Windows.Media.SolidColorBrush(System.Windows.Media.Colors.White)
P.Inlines.Add(tUser)
P.Inlines.Add(tMessage)
P.FontSize = 12
p.Margin = New System.Windows.Thickness(0, 0, 0, 0)
Related
not sure how do phrase this question but I really dont understand it.
I want to achieve the following:
TextBox = TextVorname
TextBox = TextNachname
For Example I put in the 1. Textbox "Markus"
and put in the 2. Textbox "Neumann"
I want it to display in the Bookmark "Ma.Ne_2022"
I have following Code:
Private Sub OptionButton1_Click()
Dim VornameStr As String
VornameStr = Me.TextVorname.Caption
Dim NachnameStr As String
NachnameStr = Me.TextNachname.Caption
MyStrVorname = Left(VornameStr, 2)
MyStrNachname = Left(NachnameStr, 2)
MyStrFullname = MyStrVorname & "." & MyStrNachname & "_2022"
Call UpdateBookmark("test1", Me.MyStrFullname.Caption)
End Sub
Your question is a little bit vague.. Maybe this is what you're after?
Dim MyVornameStr As String
Dim MyNachnameStr As String
Dim MyStrFullname As String
MyStrVorname = Left(Me.TextVorName.Text, 2)
MyStrNachname = Left(Me.TextNachName.Text, 2)
MyStrFullname = MyStrVorname & "." & MyStrNachname & "_2022"
Call UpdateBookmark("test1", MyStrFullname)
I've made a real estate related worksheet that includes a few cells for the property's address and a picture of a Google Maps view of the property. I want to be able to change the address in the worksheet and then click the image to have it refresh with a map of the new address. I can't figure out how to replace the image.
Here's what I've got so far:
Function scrub(s As String)
scrub = Replace(s, " ", "+")
scrub = Replace(scrub, ",", "")
End Function
Function GetImageAddress(rng As Range)
Dim cell As Range
Dim addressString As String
addressString = ""
For Each cell In rng
If cell.Value <> "" Then
If addressString <> "" Then
addressString = addressString & "+" & scrub(cell.Value)
Else
addressString = scrub(cell.Value)
End If
End If
Next cell
Dim urlstart, urlmid, urlend, key As String
key = "API_KEY" 'you'll need to get your own Google API Key for this to work
urlstart = "https://maps.googleapis.com/maps/api/staticmap?center="
urlmid = "&markers=color:0x359BB2%7C"
urlend = "&zoom=17&size=640x480&scale=3&maptype=hybrid&key=" & key
GetImageAddress = urlstart & addressString & urlmid & addressString & urlend
End Function
Sub fetchImage()
Dim rng As Range
Set rng = ActiveSheet.Range("E10:E12")
Dim url As String
url = GetImageAddress(rng)
Dim myImage As Shape
Set myImage = ActiveSheet.Shapes("Map")
'something should go here to replace myImage with a new downloaded picture.
End Sub
Use the .Fill.UserPicture property
myImage.Fill.UserPicture url
Here is an example
Option Explicit
Sub Sample()
Dim url As String
Dim myImage As Shape
url = "https://lh4.googleusercontent.com/-X3sAhOMOHzs/AAAAAAAAAAI/AAAAAAAADMM/dTqQjEqFDm4/photo.jpg?sz=32"
Set myImage = ActiveSheet.Shapes(1)
myImage.Fill.UserPicture url
End Sub
will fill the shape with your stackoverflow DP.
Note: This won't work if the original shape was an inserted picture. Insert a new shape like a rectangle, and then this will work.
I have a worksheet, to which I have added a QR code.
The QR code is an ActiveX control: Microsoft Barcode Control 14.0
The QR code is linked to a cell (A1), so that when the value in the cell changes, so does the QR code.
When I open the workbook normally, everything works as it should.
However, when I open it using Interop from a vb.net Winforms project, the QR code no longer responds when the value in the linked cell changes.
Whats more, when I right click on the barcode control, the "Microsoft Barcode Control 14.0 Object" context menu option (seen below) is missing.
The interop code that I am using to open the workbook is as follows:
Dim XLApp As New Excel.Application
XLApp.Visible = True
Dim XLBook As Excel.Workbook = XLApp.Workbooks.Open(FilePath)
Can anyone tell me what is causing this to happen? And perhaps suggest what I can do to prevent it happening.
You may call the Calculate method of the Worksheet class each time you need to update the QR code. For example, a raw sketch in VBA:
Application.EnableEvents = True
Application.ScreenUpdating = True
Sheets("QR_CodeSheet").Calculate
I could not get the Microsoft Barcode Control to function correctly with interop.
One way would be to open the file using a shell command and then hook into the process to work with it. But I found this too messy.
Instead, I decided to use google's Chart API. This does require an internet connection. But that is not a problem for me.
Here is a link for more info: https://sites.google.com/site/e90e50fx/home/generate-qrcode-with-excel
And the VBA code:
Option Explicit
'other technical specifications about google chart API:
'https://developers.google.com/chart/infographics/docs/qr_codes
Function URL_QRCode_SERIES( _
ByVal PictureName As String, _
ByVal QR_Value As String, _
Optional ByVal PictureSize As Long = 150, _
Optional ByVal DisplayText As String = "", _
Optional ByVal Updateable As Boolean = True) As Variant
Dim oPic As Shape, oRng As Excel.Range
Dim vLeft As Variant, vTop As Variant
Dim sURL As String
Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"
If Updateable = False Then
URL_QRCode_SERIES = "outdated"
Exit Function
End If
Set oRng = Application.Caller.Offset(, 1)
On Error Resume Next
Set oPic = oRng.Parent.Shapes(PictureName)
If Err Then
Err.Clear
vLeft = oRng.Left + 4
vTop = oRng.Top
Else
vLeft = oPic.Left
vTop = oPic.Top
PictureSize = Int(oPic.Width)
oPic.Delete
End If
On Error GoTo 0
If Len(QR_Value) = 0 Then
URL_QRCode_SERIES = CVErr(xlErrValue)
Exit Function
End If
sURL = sRootURL & _
sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
sTypeChart & sJoinCHR & _
sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+"))
Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
oPic.Name = PictureName
URL_QRCode_SERIES = DisplayText
End Function
Function UTF8_URL_Encode(ByVal sStr As String)
'http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.asp
Dim i As Long
Dim a As Long
Dim res As String
Dim code As String
res = ""
For i = 1 To Len(sStr)
a = AscW(Mid(sStr, i, 1))
If a < 128 Then
code = Mid(sStr, i, 1)
ElseIf ((a > 127) And (a < 2048)) Then
code = URLEncodeByte(((a \ 64) Or 192))
code = code & URLEncodeByte(((a And 63) Or 128))
Else
code = URLEncodeByte(((a \ 144) Or 234))
code = code & URLEncodeByte((((a \ 64) And 63) Or 128))
code = code & URLEncodeByte(((a And 63) Or 128))
End If
res = res & code
Next i
UTF8_URL_Encode = res
End Function
Private Function URLEncodeByte(val As Integer) As String
Dim res As String
res = "%" & Right("0" & Hex(val), 2)
URLEncodeByte = res
End Function
Is there a way to insert text to act as a "subtitle" under my chart's actual title using VBA? I would like to reference the input in cell "N21" as my subtitle text. Any help would be greatly appreciated.
Something along these lines should help you out, although I'm not sure on changing the font size.
ThisWorkbook.Sheets("Sheet1").ChartObjects(2).Activate
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "new title" & Chr(10) & Range("C3").Value
End With
The Chr(10) is your carriage return for a new line.
Following up on an excellent suggestion by Ditto, here is a VBA sub which adds a subtitle to an existing chart with an existing title, along with a test routine showing how it is called.
Sub AddSubtitle(Ch As Chart, subtitle As String, Optional fontsize As Long = 12)
Dim NewTitle As String
Dim i As Long, n As Long
Dim CT As ChartTitle
Set CT = Ch.ChartTitle
NewTitle = CT.Text
NewTitle = NewTitle & Chr(13)
i = 1 + Len(NewTitle)
NewTitle = NewTitle & subtitle
n = Len(subtitle)
CT.Text = NewTitle
CT.Format.TextFrame2.TextRange.Characters(i, n).Font.Size = fontsize
End Sub
Sub test()
Dim myChart As Chart
Set myChart = ActiveSheet.ChartObjects(1).Chart
AddSubtitle myChart, "Subtitle", 10
End Sub
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