VBA(excel)文本框的高级文本编辑 [英] Advanced text editing for VBA (excel) textbox
问题描述
序言
最近我一直在努力使用大量的excel电子表格,这些电子表格有很多文字和评论(多个人单独工作文件)。一次又一次地进行编辑(考虑新笔记)是非常困难的,因为文档导航在某些时候变得相当复杂。所以,我决定需要一些工具来获取/设置我实际需要的数据(单个单元内容,相应的注释内容,单元格行的附加数据)。
Recently I've been struggling with big excel spreadsheets that have a lot of text and comments (multiple people work on single document). It is tremendously hard to edit it again and again (considering new notes), since document navigating becomes pretty complicated at some point. So, I decided that I need some tool to get/set only the data I actually need at one moment (single cell content, corresponsive comment content, additional data for the cell's row on demand).
到目前为止已经完成
Fortunatelly的开始很简单。我填写UserForm与4个文本框(2只读,2编辑),填充所选注释的数据(按索引),以及一些允许接受/放弃更改并在注释单元格之间导航的按钮。
Fortunatelly the start was pretty easy. I filled UserForm with 4 textboxes (2 readonly, 2 for editing), that are filled with data of the selected comment (by index), and some buttons that allow to accept/discard changes and navigate between commented cells.
问题本身
首先,我需要保留文本格式,细胞。目前我没有采取任何格式化,只是文字。所有我通过搜索找到的是,我可以设置字符逐字符,类似于以下伪代码:
First of all, I need to keep text formatting when I take the text from cell. Currently I am not taking any formatting, just text. All I found by googling is that I can set formatting character by character, sort of like in the following pseudocode:
For i = 0 to Cells(Row, Col).Text.Length
MyTextBox.Text(i).FormatOption1 = Cells(Row, Col).Text(i).FormatOption1
...
MyTextBox.Text(i).FormatOptionN = Cells(Row, Col).Text(i).FormatOptionN
Next
但这种方法觉得是愚蠢的。所以,问题一是:
But this approach feels to be stupid. So, question one is:
有没有办法复制全文格式(字体,B / I / U,颜色,单元格)与文本一起,从单元格到文本框和向后,使用一行代码?
其次我实际上需要一些用户窗体中的格式化工具以我的形式进行上述文本格式,所以问题二是:
Second of all I actually need some formatting tools in the UserForm to do aforesaid text formatting in my form, so question two is:
有没有办法添加格式化工具(位于Home->字体菜单或弹出式菜单,当您在单元格中选择一些文本)到UserForm中编辑TextBox对象中的文本?
PS使用Excel 2013
P.S. using Excel 2013
有一点补充:
我以某种方式假设,如果没有直接的方式来做我在问题上描述的内容,是一些由之前创建的定制工具箱对象(EvenRicherTextBox的类)。我只是不能相信这个问题没有出现,但是我不知道为了找到那个对象需要使用什么关键字。
A bit of addition: I somehow assume that if there is no direct way to do what I've described in questions - there has to be some custom-made toolbox object (sort of EvenRicherTextBox) that was created by someone before. I just cannot believe that issue never came up, but I have no idea what keywords I need to use in order to find that object.
推荐答案
您可以尝试为此创建一个自定义类,以下是一个示例:
You could try to create a custom class for this, here's an example of how it might look:
类模块代码(命名为模块FormattedString)
Class Module code (name the module "FormattedString")
Option Base 1
Private Type FSChar
Letter As Integer
Bold As Boolean
Italic As Boolean
Underline As Boolean
Colour As Long
Size As Integer
End Type
Private strCollection() As FSChar
Private strRange As Excel.Range
Private txt As String
Public Property Let FString(value As Excel.Range)
Set strRange = value
txt = strRange.text
ReDim strCollection(1 To Len(strRange.text)) As FSChar
For i = 1 To Len(strRange.text)
With strCollection(i)
.Letter = Asc(Mid(strRange.text, i, 1))
.Bold = (strRange.Characters(i, 1).Font.Bold = True)
.Italic = (strRange.Characters(i, 1).Font.Italic = True)
.Underline = (strRange.Characters(i, 1).Font.Underline = True)
.Colour = strRange.Characters(i, 1).Font.ColorIndex
.Size = strRange.Characters(i, 1).Font.Size
End With
Next
End Property
Public Property Get FString() As Excel.Range
Set FString = strRange
End Property
Public Sub WriteFStringToCell(ByRef writeCell As Range)
writeCell.value = txt
For i = 1 To UBound(strCollection)
With writeCell.Characters(i, 1).Font
.Bold = strCollection(i).Bold
.Italic = strCollection(i).Italic
.Underline = strCollection(i).Underline
.ColorIndex = strCollection(i).Colour
.Size = strCollection(i).Size
End With
Next i
End Sub
示例: br>
(在A1中写出一些东西,使用不同的样式等等)
Sub MacroMan()
Dim testClass As FormattedString
Set testClass = New FormattedString
testClass.FString = Range("A1")
testClass.WriteFStringToCell Range("A2")
End Sub
这篇关于VBA(excel)文本框的高级文本编辑的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!