根据文本的大小和格式动态增加行 [英] Dynamic increase of rows according to the size as well format of the text
问题描述
我正在使用excel 2003和excel的vba编码制作自动化的excel，其中将文本从工作表的一个单元格复制到另一工作表的其他单元格.我有要求根据增加行 到文本，这样我就可以显示所有文本信息，而无需扩大行的高度或宽度(我采用恒定宽度= 172和高度= 60).文本是字体"Calibri".尺寸为"40".要查看它是否正确缩放到23％，我正在使用以下内容 代码:-
I am making an automated excel, using excel 2003 and vba coding of excel, in which a text is copied from one cell of a sheet to the other cells of the other sheet. I have the requirement to increase the rows according to the text so that I can show all the text information without expanding the row height or width (I am taking constant width = 172 and heigth = 60). The text is of Font "Calibri" of size "40". To see it properly zoom to 23%. I am using the following code:-
Sub Macro3()
Sub Macro3()
昏暗的strTemp作为字符串
将Dim RowIncr设置为整数
Dim intRow As Integer
将Dim intCurrRow转换为整数
将Dim intPrevRow设置为整数
将Dim intProjDescLen转换为整数
昏暗的strTempPara作为字符串
Dim intlfFlag As Integer
intlfFlag = -1
intRow = 15
intPrevRow = 0
CurPos = 0
strText = Worksheets("Sheet1").Cells(1，1).Value
intProjDescLen = Len(strText)
Dim strTemp As String
Dim RowIncr As Integer
Dim intRow As Integer
Dim intCurrRow As Integer
Dim intPrevRow As Integer
Dim intProjDescLen As Integer
Dim strTempPara As String
Dim intlfFlag As Integer
intlfFlag = -1
intRow = 15
intPrevRow = 0
CurPos = 0
strText = Worksheets("Sheet1").Cells(1, 1).Value
intProjDescLen = Len(strText)
strFind = vbLf
Dim x As Variant
变体变暗
昏昏欲睡
Dim j As Long
x = Split(strText，vbLf)
对于i = 0到UBound(x)
strFind = vbLf
Dim x As Variant
Dim y As Variant
Dim i As Long
Dim j As Long
x = Split(strText, vbLf)
For i = 0 To UBound(x)
strTemp = x(i)
如果(strTemp<>空且intlfFlag = 0)，则
strTemp = vbLf& strTemp
如果结束
RowIncr = Len(strTemp)/53 +1
intCurrRow = intRow + RowIncr + intPrevRow
工作表("Sheet2").Range("D"&(intRow + 1)&:D"&(intCurrRow)).MergeCells = True
如果(Len(strTemp)= 0)那么
strTemp = vbLf
如果结束
工作表("Sheet2").Cells(intRow + 1，4).Value = _
工作表("Sheet2").单元格(intRow +1，4).值& strTemp
带工作表("Sheet2").Cells(intRow + 1，4)
.Font.Bold = False
.Font.Underline = False
.Font.Italic = True
字体大小= 40
.VerticalAlignment = xlTop
.WrapText = True
结尾为
intPrevRow = intPrevRow + RowIncr
nbsp; bsp
如果strTemp = vbLf那么
intlfFlag = 1
其他
intlfFlag = 0
如果结束
接下来我
结束
strTemp = x(i)
If (strTemp <> Empty And intlfFlag = 0) Then
strTemp = vbLf & strTemp
End If
RowIncr = Len(strTemp) / 53 + 1
intCurrRow = intRow + RowIncr + intPrevRow
Worksheets("Sheet2").Range("D" & (intRow + 1) & ":D" & (intCurrRow)).MergeCells = True
If (Len(strTemp) = 0) Then
strTemp = vbLf
End If
Worksheets("Sheet2").Cells(intRow + 1, 4).Value = _
Worksheets("Sheet2").Cells(intRow + 1, 4).Value & strTemp
With Worksheets("Sheet2").Cells(intRow + 1, 4)
.Font.Bold = False
.Font.Underline = False
.Font.Italic = True
.Font.Size = 40
.VerticalAlignment = xlTop
.WrapText = True
End With
intPrevRow = intPrevRow + RowIncr
If strTemp = vbLf Then
intlfFlag = 1
Else
intlfFlag = 0
End If
Next i
End Sub
在这段代码中，我是根据换行符分割文本，然后计算编号.每个段落的行要求.之后，代码将合并段落所需的所有行，然后将段落复制到合并后的行中 行.下一段重复相同的步骤，直到文本结尾.但是，问题在于文本很大且包含许多段落，而每个段落都包含许多字符.在这种情况下，当合并行和段落时 复制后，即使您不扩展行的高度和宽度，即使最后几段包含段落的全部内容，最后几段也不会完全显示该信息.仅在大段落的情况下才会出现此问题，并且 具有更多的换行符.有什么方法可以将文本复制到合并单元格并显示该一个或多个单元格中的所有文本，而无需扩展行的高度和宽度.另外，不需要连接和查找，因为我希望文本是可更新的 复制到合并的行后.
In this code I am Spliting the text on the basis of line feeds and then calculating the no. of rows requirement of each paragraph. After that the code merges all the rows required for a paragraph and then copy the paragraph to the merged rows. The same step repeated for the next paragraph till the end of the text. But, the problem is when the text is huge and contains many paragraph and each paragraph contains many character. In this case when the rows are merged and paragraph are copied then the last few paragraphs does not show the information completely even if they contains the whole contents of the paragraph if you don't expand the heigth and width of the rows. This issue comes only in case of large paragraph and having more number of line feeds. Is there any way we can copy the text to the merge cells and showing all the text in that cell or cells without expanding the row heigth and width. Also, Concatenate and LookUp is not required because I want text to be updatable after being copied to the merged rows.
要求摘要:-
- 需要根据文本动态增加行数.
- 需要恒定的行高= 60，宽度= 172，字体"Calibri"尺寸为"40"的合并的行.
- 复制文本后，不需要水平和垂直扩展行.
- 合并的单元格应在复制时显示所有文本，而不会隐藏任何内容.而且，单元数据应该是可更新的.
- 如果考虑以上几点，则欢迎使用任何逻辑.
- Need to dynamic increase of rows according to the text.
- Need constant row height = 60 and width = 172 and Font "Calibri" of Size "40" of the merged rows.
- After text being copied row expansion horizontally and vertically shold not be required.
- The merged cells should show all the text as it is copied without hiding any content. Also, cell data should be updatable.
- Any logic is welcomed if above points are being considered.
请帮助！！！！！！！
Please help!!!!!!!
推荐答案
I guess this question belongs to the office development forum rather than the CLR Forum.
这篇关于根据文本的大小和格式动态增加行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
