我正在使用excel 2003和excel的vba编码制作自动化的excel,其中将文本从工作表的一个单元格复制到另一工作表的其他单元格.我有要求根据增加行 到文本,这样我就可以显示所有文本信息,而无需扩大行的高度或宽度(我采用恒定宽度= 172和高度= 60).文本是字体"Calibri".尺寸为"40".要查看它是否正确缩放到23%,我正在使用以下内容 代码:-
I am making an automated excel, using excel 2003 and vba codingof excel,in which a text is copied from one cell of a sheet to the other cells of the othersheet. 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 seeit 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 amSpliting the text on the basis ofline feeds and then calculating theno. of rows requirement of each paragraph. After that the code merges all therows required for a paragraph and then copy the paragraph to the merged rows. The same step repeated for the next paragraph tillthe end of the text. But, the problem is when the text ishuge and contains many paragraphand each paragraph contains many character. In this case when the rows are merged andparagraph are copiedthen the last few paragraphs does not show the information completely even if they containsthe 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.
要求摘要:-
请帮助!!!!!!!
Please help!!!!!!!
推荐答案
我猜这个问题属于 办公开发论坛,而不是CLR论坛.
I guess this question belongs to the office development forum rather than the CLR Forum.
更多推荐
根据文本的大小和格式动态增加行
发布评论