I changed the FontCombo now to FtcStyleDropDownCombo instead of FtcStyleDropDownList.
However, it would be interesting to know what FontName the RichTextBox has but the FontCombo did not load .. you know what I mean ?
Printable View
This is "MS Sans Serif". In my system it named "Microsoft Sans Serif".
wikipedia/Microsoft_Sans_Serif
https://www.vbforums.com/images/ieimages/2024/03/11.png
Yeah, but both are in the FontCombo... So, having FtcStyleDropDownList implies that the RichTextBox has a font which the FontCombo does not have in it's list, thus erroring. FtcStyleDropDownCombo will not error if it's not existing in the list. Can you re-check ?
Attachment 190718
PS: Both MS Sans Serif and Microsoft Sans Serif are valid and both should exist. MS Sans Serif is a bitmap font and Microsoft Sans Serif is a true-type font.
Not in my FontCombo. WinXP SP3 (edition 2021 from here).
https://www.vbforums.com/images/ieimages/2024/03/13.png
Should, but not must. This is a clean WinXP SP2 with MS Office 2002:
https://www.vbforums.com/images/ieimages/2024/03/14.png
Yahoo!!! I've found it!
Yes, this is not true-type font, so I've found it in a notepad...
https://www.vbforums.com/images/ieimages/2024/03/15.png
Update released.
Accelerator keys support in a VBA environment.
The same technique as in the VBFlexGrid control (which supports it already a while ago) is now implemented on each control where accelerator keys are applicable. (PreTranslateMsg)
To note is that this is a preparation for a future 1.8 OCX. This will not be implemented in the 1.7 OCX as it would be necessary to delete the .exd files in the VBE and Forms folder.
So, I decided to have it ready then for a fresh 1.8 someday.
Krool,
I am using the ListView control. It works great especially in virtual mode. However, I want to change the width of a column and I can't figure out how to do it. In the old ListView control you would use .Controls.item(x).Width = somevalue but your control does not have "Controls" or "Item()". I looked at your code for Get/Set ColumnWidth and you can set or get a Single that is the ColumnWidth but there doesn't seem to be any way to specify which column to use. I know it must be possible and probably easy but I can't figure out how to do it.
That works. Thanks!
Another question: I was surprised a while back that you got LabelW to have hWnd as a property. I didn't think much more about it until this week. When I run the debugger in VB6, I don't get any LabelW controls but I do get a lot of controls that look like and are named as labels but appear as TextBoxes. So it seems to me that you don't use the Label control and what we are calling LabelW's are actually restricted TextBoxes that appear as labels and that is how you can get an hWnd for a label. Is this correct?
I'll investigate further.
However, on a related note, I am using your latest VBCCR17.OCX version and it does not include WindowedLabel.
When I run the ComCtlsDemo and look in the form toolbox it is there.
Is there a reason it is not in VBCCR17.OCX or am I doing something wrong?
can the limit to the contents of the RichTextBox. be increased to more than 65536
You can send the "EM_EXLIMITTEXT" message to increase the characters limit:
Code:Private Const EM_EXLIMITTEXT As Long = &H435, lMaxLimit As Long = &H7FFFFFFF
SendMessage RichTextBox.hWnd, EM_EXLIMITTEXT, 0&, lMaxLimit
When I'm in this situation, and I've been there, I typically turn to the Scintilla OCX control. That thing will do just about anything you want to throw at it (within the limits of what a 32-bit program can do).
Also, it feels like we're spamming this codebank thread. I'm not sure why this isn't in the typical Q&A section.
Update released.
Included the Resize event in the FrameW control. (like the VB.Picture control)
A control container should have such event to re-arrange it's contained controls.
However, the VB.Frame control does not have it.
If I use SendMessageW(combo,CB_ADDSTRING,0,1) to add contents to a combo, when I click on the combo it only opens up with one item, as opposed to showing 10 items.
Any help appecirated
I got around it by doing the following :
Even though the Combo supports the .Redraw method, whilst doing tests, I still find using SendMessage a quicker way to add large amounts to combos.Code:For iSockets = 0 To 9999
If iSockets < 10 Then
cmbSockets.AddItem iSockets
cmbSockets.ItemData(cmbSockets.NewIndex) = iSockets
Else
lngAddIndex = SendMessageW(cmbSockets.hWnd, CB_ADDSTRING, 0, StrPtr(iSockets))
SendMessageW cmbSockets.hWnd, CB_SETITEMDATA, lngAddIndex, ByVal iSockets
End If
Next iSockets
cmbSockets.ListIndex = 0
Lee.
I am trying a test of the richtextbox control to see if I can paste in some chinese text.
I created a new project and put a reference to oleguids.tlb, that file located in the project folder but none of the new controls are there.
I also tried regserv32 that file in the syswow64 folder but it gave me error.
I am running windows 11 PRO
What do I need to do?
Whatever I am doing is not working
Update released.
Included the AutoVerbMenu in the RichTextBox control.
The MS RTB does localize it, so why not, for compatibility? The .NET version also allows the user to replace it with a custom one optionally calling the functions provided by the items of the default one. I did that 2 times already.
I guess the richtx32.ocx does not localize it .. or am I wrong ?
Code:2000 MENU
LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
{
POPUP "Context"
{
MENUITEM "&Undo\tCtrl+Z", 2104
MENUITEM SEPARATOR
MENUITEM "Cu&t\tCtrl+X", 2100
MENUITEM "&Copy\tCtrl+C", 2101
MENUITEM "&Paste\tCtrl+V", 2102
MENUITEM "&Delete\tDel", 2103
MENUITEM SEPARATOR
MENUITEM "&Object", 2110
}
}
Hi, after you reference it then what do you do?
I do see it in the references and have it checked.
I do not see any new controls showing in the toolbox on the left.
I see in your example user controls showing up on the right in the IDE.
Must be something left for me to do to use them
I am used to toolbox controls.
Thanks for any help.
in an inspiration moment I found this
https://www.vbforums.com/showthread....mmon-controls)
downloaded. put it in the vb6 IDE, then compiled as an OCX control.
Is this what gets referenced in the vb6 ide?
I get a name conflicts error
How to get beyond that?
someone said they had something twice in their vbp file, so here is mine, dont see anythng twice
Code:Type=Exe
Reference=*\G{00000300-0000-0010-8000-00AA006D2EA4}#2.5#0#..\Program Files (x86)\Common Files\System\ado\msador15.dll#Microsoft ActiveX Data Objects Recordset 2.5 Library
Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; ieframe.dll
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#..\Windows\SysWOW64\scrrun.dll#Microsoft Scripting Runtime
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\Windows\SysWOW64\stdole2.tlb#OLE Automation
Reference=*\G{7C0FFAB0-CD84-11D0-949A-00A0C91110ED}#1.0#0#..\Windows\SysWOW64\msdatsrc.tlb#Microsoft Data Source Interfaces
Reference=*\G{56BF9020-7A2F-11D0-9482-00A0C91110ED}#1.0#0#..\WINDOWS\SysWow64\MSBind.dll#Microsoft Data Binding Collection
Reference=*\G{8620B873-D801-11D2-AC47-00600832A1F6}#2.1#0#..\WINDOWS\SysWow64\VBPrnDlg.dll#Microsoft VB Printer Dialog(PSS)
Reference=*\G{2A75196C-D9EB-4129-B803-931327F72D5C}#2.8#0#..\Program Files (x86)\Common Files\System\ado\msado28.tlb#Microsoft ActiveX Data Objects 2.8 Library
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0; mscomctl.OCX
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; mscomct2.ocx
Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; richtx32.Ocx
Object={648A5603-2C6E-101B-82B6-000000000014}#1.1#0; MSComm32.Ocx
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; ComDlg32.OCX
Object={BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0; TabCtl32.Ocx
Form=frmSearch.frm
Form=frmLogon.frm
Form=frmMaintain.frm
Form=frmData.frm
Form=frmMarcIn.frm
Form=frmMarcOut.frm
Form=frmPatron.frm
Form=frmPatronDelete.frm
Form=frmPatronSearch.frm
Form=frmCheckout.frm
Form=frmOverDue.frm
Form=frmAbout.frm
Form=frmMarcSearch.frm
Class=clsElasticForms; clsElasticForms.cls
Module=Module2; Choosecolor.bas
Form=frmMarcChoices.frm
Form=MDIMarc.frm
Form=frmFind.frm
Form=frmMarcBrkr.frm
Form=frmHelpBrkr.frm
Module=Module1; LogonPrivelege.bas
Form=frmDisplay.frm
Form=frmChoicesHelp.frm
Form=frmadder.frm
Form=frmRepair.frm
Module=Module5; Slidder1.bas
Module=Module3; MarcUpdate.bas
Module=Module6; PublicFunction.bas
Form=frmCirc.frm
Module=Module7; CircRecorder.bas
Module=Module8; MarcBrkr.bas
Module=Module9; SQLCreatedatabase.bas
Module=Module11; MSDEcreateDatabase.bas
Form=frmOpener.frm
Form=frmSortSdls.frm
Form=frmMarcExporter.frm
Form=frmMarcTagExport.frm
Form=frmMSDEConnect.frm
Form=frmPrintSpline.frm
Form=frmPrintBarcodes.frm
Form=frmPrintRecord.frm
Class=RegAccess; Regacces.cls
Form=frmMSDEmaster.frm
Form=frmGlobalsettings.frm
Form=frmPatronLimit.frm
Form=frmPrintPRecord.frm
Form=frmPrintPBarcode.frm
Form=frmPrintPLabels.frm
Form=frmFailure.frm
Form=frmStoredQuery.frm
Form=frmINternet.frm
Class=clsFormResizer; clsFormResizer.cls
Form=frmDewey2.frm
Form=frmFindRecord.frm
Form=frmCheckAdjust.frm
Form=frmDatabaseSelect.frm
Form=frmSearchfirst.frm
Form=frmLOCsearch2.frm
Module=Module10; Util.bas
Form=frmNag.frm
Form=frmList.frm
Form=frmRepairMysql.frm
Form=frmDisplayMessage.frm
Form=frmTagSort.frm
Form=frmInsert008.frm
Form=frmInsert007.frm
Form=frmAlterMysql.frm
Class=UndoElement; UndoElement.cls
Module=MyHyperlink; MyHyperlink.bas
Module=Module4; Module4.bas
Form=frmLists.frm
Form=frmListsInput.frm
Module=Module12; marcwriter2.bas
Form=frmCHistory.frm
Module=Module13; showfont.bas
Form=frmWaitNotice.frm
Form=frmDisplayMessage2.frm
Form=frmDelete.frm
Module=PublicVars; PublicVars.bas
IconForm="frmData"
Startup="frmLogon"
HelpFile=""
Title="BookStore"
ExeName32="BookStore.exe"
Command32=""
Name="BookStore"
HelpContextID="0"
CompatibleMode="0"
MajorVer=2
MinorVer=3
RevisionVer=1
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Hampton Christian Schools"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1
[RVB]
DeleteClass1=Module13
DeleteClass2=Module13
DeleteClass3=frmTranslate
DeleteClass4=frmStoredQuery2
DeleteClass5=frmStoredQuery2
DeleteClass6=Module10
Well could it be the MS common control reference must first be removed to add in this new one?
I don't actually know what I am talking about here, as I don't see that kind of reference in the list.
I think doing that all the forms current controls will be gone.
Do you have to redesign all the forms again with the new controls?
Or is there another way to do this?
I can try it on a program backup to see what happens. I have a lot forms and a lot of controls on them.
Too bad MS cared nothing about Unicode at the time they created vb6 controls, that was a serious flaw in vb6.
EDIT here
I may be on to something.
I removed reference to OLE Automation, vb6 IDE let me remove it.
Then program would not run, so it needs that. Left it out.
Then I went to components and added the new unicode controls OCX, vb6 IDE accepted them.
Then went back to references, added OLE Automation back in
It took it in the vb6 IDE. And the new controls appear on the left side tool box list.
Program runs
?? Anyone know why it does this?
I found out OLE Automation had to be not in the references by creating a new EXE project.
Without it, I was able to add the unicode components.
So am I doing it correctly now?
These Unicode aware controls as Great!
Setup a little test using right click paste and sendmessage to paste into box chinese text, it works good
Example is very simple here, 2 rtb, one is MS, one is Krool's.
All i did was after compiling the OCX referenced it using components manage in the vb6 IDE
chinese text keyboard is here https://www.branah.com/chinese
also seeing if I can send a sample code of the project here
I found an issue when mixing the Krool RTB control and the MS RTB control on the same form.
Has to do with a function to enable URL detection which I have used for decades. it lights up a url in blue showing it as a hyperlink.
It seems to work ok if all the RTB are MS or all the RTB are Krool
But here I have 2 krool RTB, then 1 MS RTB, and the function dies and complains about type mismatch 13
I have 2 versions of functions to detect url and both do the same failure. And then nothing you can do except delete the failing RTB control, it will never work again.
for this example, the first 2 lines execute fine, hits number 3 and it dies with the error.
MyDetectURL rtxtMarckrool1, True, rtxtMarckrool1
MyDetectURL rtxtMarckrool2, True, rtxtMarckrool2
MyDetectURL RichTextBoxMS, True, RichTextBoxMS
EnableAutoURLDetection RichTextBoxMS
If you can look into it, just run it, dont run with full compile as it is incomplete.
I was messing with deleting RTB and putting new one on same form with different names but I see no discernable failure pattern.
Something happens with the RTB control, either MS or Krool when mixed together on a form and the
MyDetectURL and EnableAutoURLDetection function hates it.
Well, one way around this, dont use that external enable URLdetection function as Krool's box has already URL autodetect enabled, if in the property pages you enable that. MyUrlAutodetect will turn that on in the box regardless of the setting.
Tested and working.
And it must somehow be similar as it still has the bug of autodetecting a fake URL
You can witness that by typing in the rtb, \\anytextyoulike and it lights up as a URL hyperlink.
It also does the same thing with MS rtb and the myurlautodetect function
What is real crappy though is I discovered this problem follows the whole project as in any form with a richtextbox will fail trying to use myurlautodetect. It just makes more work as you have to do all of them if you want to run program for testing. I have like 20 rtb scattered on many forms
So that really commits you.
That means all the RTB must be replaced on every form in the project, if you want URLs working.
I added a second form with an MS RTB and it dies with type mismatch 13
command button causes form2.show and the myurlautodetect is in the form load
and it dies
Is there another way to do a rtb.span ? With the new control?
That method is gone.
I do this to reset the font colors to black.
see on searches, I light up found search text with a blue color
That needs to go away back to black text in the RTB
Public Function InitializeRichText(RTB As RichTextBox, lcolor As Long) As Integer
'Initialize richtext box to black
'rtb.SelStart = 0
RTB.Span (RTB.Text)
'rtb.SelLength = Len(rtb.Text)
RTB.SelBold = False
RTB.SelColor = lcolor
End Function
for this form I solved by removing the function and just doing the process in the paintform sub directly.
This control does not like being referenced like RTB as Richtextbox in a public function?
Since I reset a bunch of rtb back to black after searches found, it will add more lines of programming unless someone knows how to use this in a function like the below line shows.
**********************************************************************************
'RichTextBlack
'Public Function InitializeRichText(RTB As RichTextBox, lcolor As Long) As Integer
'Initialize richtext box to black
**********************************************************************************
this here worked
rtxtMarc.SelStart = 0
rtxtMarc.SelLength = Len(rtxtMarc.Text)
rtxtMarc.SelBold = False
rtxtMarc.SelColor = vbBlack
Code:Public Sub SetForeColor(Optional lForeColor As ColorConstants = vbBlack)
Dim tCharFormat As CHARFORMAT2
With tCharFormat
.cbSize = LenB(tCharFormat): .crTextColor = lForeColor: .dwMask = CFM_COLOR
End With
SendMessage RTB.hWnd, EM_SETCHARFORMAT, SCF_ALL, VarPtr(tCharFormat)
End Sub
yeah, it's not liking any RTB as Richtexbox functions in my program
wont color the string using it
oddly though no type mismatch error, it just never even enters the function
X = 0
Do Until X > UBound(Keywords1)
sFindit = Keywords1(X)
HighlightWords rtxtMarc, sFindit, vbBlue, Cntr2
Cntr = Cntr + Cntr2
X = X + 1
Loop
red text supposed to jump into function here, but stepping thru skips past it and no error!
EDIT, fixed by doing this
Public Function HighlightWords(RTB As VBCCR17.RichTextBox, _
sFindstring As String, _
lcolor As Long, _
ccntr As Integer) _
As Integer
Code:Public Function HighlightWords(RTB As RichTextBox, _
sFindstring As String, _
lcolor As Long, _
ccntr As Integer) _
As Integer
Dim lFindLength As Long 'Length of string to find
Dim iMatchCount As Integer 'Number of matches
Dim boolon As Boolean
Dim aa As Long
boolon = RTB.Visible
RTB.Visible = False
frmDatatrapUndo = False 'set to false since highlighting is not a recognized change
'Cache the length of the string to find
lFindLength = Len(sFindstring)
'needs to always start at 1, but after finding can start at aa + lFindLength
'match test to get going
aa = InStr(1, RTB.Text, sFindstring, vbTextCompare)
'match found
If aa <> 0 Then
iMatchCount = iMatchCount + 1
RTB.SelStart = aa - 1 'rtb counts first position as 0
RTB.SelLength = lFindLength
RTB.SelBold = True
RTB.SelColor = lcolor
Do
aa = InStr(aa + lFindLength, RTB.Text, sFindstring, vbTextCompare)
If aa = 0 Then Exit Do
iMatchCount = iMatchCount + 1
RTB.SelStart = aa - 1 'rtb counts first position as 0
RTB.SelLength = lFindLength
RTB.SelBold = True
RTB.SelColor = lcolor
Loop
End If
'Restore the insertion point to zero
RTB.SelStart = 0
'Return the number of matches
ccntr = iMatchCount
If boolon = True Then
RTB.Visible = True
Else
RTB.Visible = False
End If
End Function
Hi, thanks very much
Doing that has fixed my public function for coloring rtxtMarc
I suppose this will work for all the RTB functions
Public Function HighlightWords(RTB As VBCCR17.RichTextBox, _
sFindstring As String, _
lcolor As Long, _
ccntr As Integer) _
As Integer
EDIT, I am switching to using as Object as that works and I think it's a better idea rather than hardcoding in the ocx version
Public Function HighlightWords(RTB As Object, _
sFindstring As String, _
lcolor As Long, _
ccntr As Integer) _
As Integer
I copied that from my own RichTextBox class, you may want to take a look at it if you want to learn more about RichTextBoxes. For example you don't need to implement your own text search routine since the RichTextBox can do that for you in a much better way (with the EM_FINDTEXTEX message), it can search forward, backward, case sensitive/insensitive, match whole word or partial.
That is helpful
I was then able to load a 139mb text file into this RTB control, it took couple minutes to load and then to be able to access it.
How big a file does that sendmessage command allow to load into a RTB?
Is that as big as it gets or can you get more.
139 mb in the file corresponds with 75,000 individual MARC records in my file. Which is a lot of records.
Think 75,000 items in a library. And all in one file. Conceivably most people would break up a file to make it more manageable.
It takes 9 secs to load the 139mb into a MS RTB and it takes 3 minutes to load in the Krool unicode RTB.
I am using this method here, is there a better way?
'load file method
MDIMarc.rtxtMarc.Enabled = False
MDIMarc.rtxtMarc.LoadFile (CommonDialog1.FileName), rtfText
MDIMarc.rtxtMarc.Enabled = True
I finally get to see unicode languages in the MariaDB and the program
I had to put this in my.ini and restart the DB server
and then had to modify the database and a table to use CHARACTER SET utf8;
I's all in these links. Will work for MySql or MariaDB
https://stackoverflow.com/questions/...in-mysql-table
https://stackoverflow.com/questions/...24493#20624493
C:\Program Files\MariaDB 11.3\bin>mariadb -u root -p --port=3308
Enter password: ****
Welcome to the MariaDB monitor. Commands end with ; or \g.
Your MariaDB connection id is 18
Server version: 11.3.2-MariaDB mariadb.org binary distribution
Copyright (c) 2000, 2018, Oracle, MariaDB Corporation Ab and others.
Type 'help;' or '\h' for help. Type '\c' to clear the current input statement.
MariaDB [(none)]>
MariaDB [(none)]> ALTER DATABASE testspecialchars CHARACTER SET utf8;
Query OK, 1 row affected (0.007 sec)
MariaDB [(none)]> use testspecialchars;
Database changed
MariaDB [testspecialchars]> ALTER TABLE bookdata CONVERT TO CHARACTER SET utf8;
Query OK, 3 rows affected (0.051 sec)
Records: 3 Duplicates: 0 Warnings: 0
And the picture shows greek and chinese text in the DB displaying properly
I am able to just copy, paste, update unicode now
This is really cool
Small change..
Ctrl+Alt+V shortcut changed to Ctrl+Shift+V as this is common for Me.PasteSpecial CF_UNICODETEXT.
Menu text changed from 'Paste Special' to 'Paste as plain text'.
Ctrl+Alt+V should be reserved for a paste special dialog box to choose a format. (like Wordpad)
Attachment 191206
German translation also added. I may add others as well soon without further notice.
Hi, wide combo box is the new combobox?
This no longer works with the new control
Any ideas why?
it's listcount when form loads is zero
EDIT, it looks like an empty wCombobox does not work anymore here.
As I put in a value cboFind.AddItem ("test"), and then the cboFind.list(0) came up with 'test'
So it does not like a totally empty combo box which the original non unicode control was ok with
Private Sub cmbFindCheck()
For xxx = 0 To cboFind.ListCount
If cboFind.List(xxx) = cboFind.Text Then Exit Sub 'found in box
Next xxx
If Trim(cboFind.Text) <> "" Then cboFind.AddItem cboFind.Text ' not found add it
End Sub
I added this in the formload
cboFind.AddItem ("")
cboReplace.AddItem ("")
And changed to this
For xxx = 0 To cboFind.ListCount - 1
Which allows the form to function, and it does find all the individual chinese and greek and english chars, and can replace them.
But it then has an empty added in item first in the box which you see when it drops down, prefer not to see that empty string in the combo box.
At least right now it works.
EDIT again. I got it like it should be working.
I left off the additem "" at form load and everything is as it was.
It really needed 'Listcount - 1' to be there to let it not enter the For Next when the box is empty.
Is there a way for the msgbox to display the unicode string chars in a message?
It will just show question marks like this for cboFind variable, which is a unicode string.
So in the msgbox, it says, "Finished searching for ?" rather than showing the unicode chars.
Code:If lngResult = -1 Then
'Text not found
MsgBox "Finished searching for '" & cboFind & "'", vbInformation, "BookStore Editor"
cmdFind.Caption = "&Find" 'Set caption
cmdReplace.Enabled = False 'Disable Replace button
cmdReplaceAll.Enabled = False 'Disable ReplaceAll button
SOLVED!
Can't believe how much progress I made today.
Found this function for a wide msgbox, and it works. I have frmFind.hWnd in there as that is my form running the finds.
The code is in a module.
run it like this in programCode:Private Declare Function MessageBoxW Lib "User32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
Public Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Access") As VbMsgBoxResult
MsgBoxW = MessageBoxW(frmFind.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function
MsgBoxW "Finished searching for '" & cboFind & "'", vbInformation, "BookStore Editor"
results in the pic
@sdowney1, maybe you should start new threads for asking questions..
If you need French :
Cut : Couper
Copy : Copier
Paste : Coller
Paste special : Collage spécial
Paste as plain text : Coller sans mise en forme (or : Texte non formaté)
Code:Case &HC ' French
Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&Répéter" & vbTab & "Ctrl+Y", "&Couper" & vbTab & "Ctrl+X", "C&opier" & vbTab & "Ctrl+C", "Co&ller" & vbTab & "Ctrl+V", "Coller &sans mise en forme" & vbTab & "Ctrl+Shift+V", "&Effacer" & vbTab & "Suppr")
Thanks. Though "Supprimer" seems to be more common than "Effacer". I looked at the notepad ++ language xml files for a little help. :)
I also added now Chinese, Czech, Danish, Greek, Spanish, French, Italian, Japanese, Portuguese, Russian and Swedish.
Others may follow ..
Krool - any plans to modernize the VB DriveListBox control?
Updated manifest in the OCX thread which applies now the miscStatus* attributes. Thanks to wqweto and his UMMM tool.
Hello Krool!
Compilation Error Feedback:
1?ComCtlsDemo.zip "Last edited by Krool; Yesterday at 07:24 PM. "
2. In the IDE environment, there is garbled characters, and it cannot be compiled normally. This has never happened before. Related process name "Friend Sub FIRichEditOleCallback_GetContextMenu"
3?"VBCCR17 1.7.104 Last edited by Krool; Yesterday at 02:23 AM." ---OK
4. Operating system version "Win10 Chinese Simplified Chinese Version"
5. VB6 version: VB6 SP6, VBA9782
Please help resolve this error, thank you very much!
Attachment 191241
Code:#If VBA7 Then
Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As LongPtr, ByVal lpCharRange As LongPtr, ByRef hMenu As LongPtr)
#Else
Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As Long, ByVal lpCharRange As Long, ByRef hMenu As Long)
#End If
If PropAutoVerbMenu = False Then
Dim RECR As RECHARRANGE
CopyMemory RECR, ByVal lpCharRange, LenB(RECR)
RaiseEvent OLEGetContextMenu(SelType, LpOleObject, RECR.Min, RECR.Max, hMenu)
Else
hMenu = CreatePopupMenu()
Dim LangID As Integer
LangID = GetUserDefaultUILanguage() And &HFF&
Dim MII As MENUITEMINFO, Text As String, i As Long
MII.cbSize = LenB(MII)
For i = 1 To 7
Select Case LangID
Case &H4 ' Chinese
Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
Case &H5 ' Czech
Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop?ovat" & vbTab & "Ctrl+C", "&Vlo?t" & vbTab & "Ctrl+V", "Vlo?t &jako prost?text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
Case &H6 ' Danish
Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "S? &ind" & vbTab & "Ctrl+V", "Inds? som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
Case &H7 ' German
Text = VBA.Choose(i, "&R?kg?gig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf?en" & vbTab & "Strg+V", "Nur &Text einf?en" & vbTab & "Strg+Umschalt+V", "&L?chen" & vbTab & "Entf")
Case &H8 ' Greek
Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
Case &H9 ' English
Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
Case &HA ' Spanish
Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s?o texto" & vbTab & "Ctrl+May?+V", "&Borrar" & vbTab & "Supr")
Case &HB ' Finnish
Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit? & vbTab & "Ctrl+V", "Liit?pelkk??&tekstin? & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
Case &HC ' French
Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R?ablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
Case &H10 ' Italian
Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
Case &H11 ' Japanese
Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
Case &H15 ' Polish
Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon?" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
Case &H16 ' Portuguese
Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
Case &H18 ' Romanian
Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
Case &H19 ' Russian
Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
Case &H1D ' Swedish
Text = VBA.Choose(i, "&?gra" & vbTab & "Ctrl+Z", "&G? om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
Case Else
Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
End Select
MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_STRING
MII.fType = 0
MII.dwTypeData = StrPtr(Text)
MII.cch = Len(Text)
MII.hBmpItem = NULL_PTR
Select Case i
Case 1
If Me.CanUndo = True Then
MII.fState = MFS_ENABLED
Else
MII.fState = MFS_DISABLED
End If
Case 2
If Me.CanRedo = True Then
MII.fState = MFS_ENABLED
Else
MII.fState = MFS_DISABLED
End If
Case 3, 4, 7
If (SelType And SEL_TEXT) = SEL_TEXT Or (SelType And SEL_OBJECT) = SEL_OBJECT Then
MII.fState = MFS_ENABLED
Else
MII.fState = MFS_DISABLED
End If
Case 5
If Me.CanPaste = True Then
MII.fState = MFS_ENABLED
Else
MII.fState = MFS_DISABLED
End If
Case 6
If Me.CanPaste(CF_UNICODETEXT) = True Then
MII.fState = MFS_ENABLED
Else
MII.fState = MFS_DISABLED
End If
End Select
MII.wID = i
InsertMenuItem hMenu, 0, 0, MII
Next i
MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_FTYPE
MII.fType = MFT_SEPARATOR
MII.dwTypeData = 0
MII.cch = 0
MII.hBmpItem = NULL_PTR
MII.fState = 0
MII.wID = i
InsertMenuItem hMenu, 2, 1, MII
End If
End Sub
You may have BETA windows feature non-unicode UTF8 option enabled. This garbles ANSI files. (Range 128 to 255 I guess)
https://stackoverflow.com/questions/...rt-actually-do
Edit: I guess the best is to ChrW() also those chars which ANSI could display but are above 128 and causes issues on UTF-8.
smileyoufu,
below is the adjustment which should work and display the characters correctly even when the non-unicode app option "utf-8" is enabled.
Can you confirm ? Then I would update the project soon.
Code:Select Case LangID
Case &H4 ' Chinese
Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
Case &H5 ' Czech
Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop" & ChrW(&HED&) & "rovat" & vbTab & "Ctrl+C", "&Vlo" & ChrW(&H17E&) & "it" & vbTab & "Ctrl+V", "Vlo" & ChrW(&H17E&) & "it &jako prost" & ChrW(&HFD&) & " text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
Case &H6 ' Danish
Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "Sæt &ind" & vbTab & "Ctrl+V", "Inds" & ChrW(&HE6&) & "t som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
Case &H7 ' German
Text = VBA.Choose(i, "&R" & ChrW(&HFC&) & "ckg" & ChrW(&HE4&) & "ngig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf" & ChrW(&HFC&) & "gen" & vbTab & "Strg+V", "Nur &Text einf" & ChrW(&HFC&) & "gen" & vbTab & "Strg+Umschalt+V", "&L" & ChrW(&HF6&) & "schen" & vbTab & "Entf")
Case &H8 ' Greek
Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
Case &H9 ' English
Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
Case &HA ' Spanish
Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s" & ChrW(&HF3&) & "lo texto" & vbTab & "Ctrl+May" & ChrW(&HFA&) & "s+V", "&Borrar" & vbTab & "Supr")
Case &HB ' Finnish
Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit" & ChrW(&HE4&) & vbTab & "Ctrl+V", "Liit" & ChrW(&HE4&) & " pelkk" & ChrW(&HE4&) & "n" & ChrW(&HE4&) & " &tekstin" & ChrW(&HE4&) & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
Case &HC ' French
Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R" & ChrW(&HE9&) & "tablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
Case &H10 ' Italian
Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
Case &H11 ' Japanese
Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
Case &H15 ' Polish
Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon" & ChrW(&HF3&) & "w" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
Case &H16 ' Portuguese
Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
Case &H18 ' Romanian
Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
Case &H19 ' Russian
Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
Case &H1D ' Swedish
Text = VBA.Choose(i, "&" & ChrW(&HC5&) & "ngra" & vbTab & "Ctrl+Z", "&G" & ChrW(&HF6&) & "r om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
Case Else
Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
End Select