Vba word对象高度问题

Question

我有一个很奇怪的问题我不明白。

我有一个 table，里面有一堆关于如何处理建筑项目的信息。越来越多的 'recipes' 解释了项目的具体内容。在 table 中，每一行是一个食谱，列是如何、为什么、何时、注释等。我的程序获取每一行的信息并将其放入一个新的 sheet 中。然后它将其打印为 pdf 并占用下一行。问题与 'how' 列有关。它可以很长，所以我用一个词对象把它放到新的sheet中。它在富文本等方面效果很好，但对于特别长的文本，单词对象的高度不会显示整个文本。好像物体的高度不能超过1240px？有帮助吗？

Ps: 使用 excel 2003，不幸的是。

Sub Embed_WordDocument_To_sheet()

Dim oWS As Worksheet ' Worksheet Object

Dim oWD As Document ' Word Document Object (Use Microsoft Word Reference)

Set wsFactark = Worksheets("Oversigtsark") ' thats the main table with the recipes

Set oWS = ActiveSheet

' embed Word Document
ws.Range("C3").Select
Set oOLEWd = oWS.OLEObjects.Add("Word.Document")



oOLEWd.Name = "EmbeddedWordDoc"
oOLEWd.Width = 375
'oOLEWd.Height = 10 ' will be changed later
oOLEWd.Top = ws.Range("C3").Top + 2 ' +2 for ikke at overstrege border-linjen
oOLEWd.Left = ws.Range("C3").Left + 5 ' samme
oOLEWd.ShapeRange.LockAspectRatio = msoFalse
oOLEWd.Placement = xlFreeFloating

' Assign the OLE Object to Word Object
Set oWD = oOLEWd.Object
wsFactark.Cells(I + 4, 13).Copy

oWD.Paragraphs(oWD.Paragraphs.Count).Range.PasteAndFormat (wdFormatOriginalFormatting)

With oWD.PageSetup
.TopMargin = 0
.BottomMargin = 0
.LeftMargin = 0
.RightMargin = 0
    .PageHeight = 1584 'max
    .PageWidth = 1584
End With


oOLEWd.Activate
oOLEWd.ShapeRange.ScaleHeight 1, msoTrue
oOLEWd.ShapeRange.ScaleWidth 1, msoTrue
oOLEWd.ShapeRange.Line.Visible = msoFalse

' trying to make the object show all the text, and not stop at 1240px. Doesn't work so far. :/ thought windowState would do it, but no. 
' prøver at få objectet til at kunne vise hele teksten, og ikke stoppe ved 1240 px.
oOLEWd.Application.WindowState = xlMaximized
oOLEWd.Height = Application.UsableHeight


oOLEWd.Width = 375

Answer 1

我还没有机会对此进行测试，但它应该将您的 "recipe" 解析为多个单元格，从 C3 开始。我假设这些是写成句子的，所以我找到了 1024 个字符以内的最后一个句点，并将所有内容都放在第一个单元格中，然后从那里继续。

Sub StackTest()
Dim strRecipe As String
Dim intEndOfSent As Integer
Dim strPieceOfRecipe As String
Dim intCellRowToPasteIn As Integer

intCellRowToPasteIn = 3

If Len(strRecipe) > 1024 Then
    Do While Len(strRecipe) > 1024
        strPieceOfRecipe = Left(strRecipe, 1024)
        intEndOfSent = InStrRev(strPieceOfRecipe, ".")
        ThisWorkbook.ActiveSheet.Range("C" & intCellRowToPasteIn).Value = Left(strRecipe, intEndOfSent)
        strRecipe = Right(strRecipe, Len(strRecipe) - intEndOfSent)
        intCellRowToPasteIn = intCellRowToPasteIn + 1
    Loop
Else
    ThisWorkbook.ActiveSheet.Range("C3").Value = strRecipe
End If

End Sub

Vba word对象高度问题

Vba word object height problems

excel

vba

ms-word

object