Excel Word Wrap работает неправильно после макроса - PullRequest
Новая
       6

Excel Word Wrap работает неправильно после макроса

2 голосов
/ 27 января 2010

У меня есть макрос, который я использую, чтобы получать данные из InputBox и затем вставлять эти данные в ячейку. У меня возникают проблемы с форматированием данных после запуска следующего макроса. 

Sub InsertNotes()
'
' insertnotes Macro
'

'
    Dim UserNotes As String

    UserNotes = InputBox(Prompt:="Please enter your note below:", Title:="Note input", Default:="Notes")
    If UserNotes = "" Then Exit Sub
    ActiveSheet.ListObjects("Notes").ListRows.Add (1)
    ActiveSheet.Range("Notes").Cells(1, 1) = Date
    ActiveSheet.Range("Notes").Cells(1, 2) = UserNotes

End Sub

Ячейки таблицы отформатированы так, чтобы иметь перенос слов, но когда примечания вставляются в таблицу, ячейки не переносятся. Однако, если я снова запустите макрос и вставлю новую заметку, вставленная предыдущая заметка будет отображаться как обернутая, даже если с ней ничего не произошло, за исключением того, что она будет сдвинута вниз по строке. Что-то, что я могу сделать в коде или форматировании, чтобы правильно обернуть его?

Ответы [ 2 ]

0 голосов
/ 29 января 2010

Единственное исправление, которое я нашел для этого, - это вставить нужную мне строку, а затем вставить и удалить еще одну строку после этого. По какой-то причине свойство переноса слов вступает в действие и начинает работать после вставки (а затем оно удаляется, так как оно не нужно). 

Sub InsertNotes()
'
' insertnotes Macro
'

'
    Dim UserNotes As String
    ' Turn off screen updating
    Application.ScreenUpdating = False
    UserNotes = InputBox(Prompt:="Please enter your note below:", Title:="Note input", Default:="Notes")
    If UserNotes = "" Then Exit Sub
    ActiveSheet.ListObjects("Notes").ListRows.Add (1)
    ActiveSheet.Range("Notes").Cells(1, 1) = Date
    ActiveSheet.Range("Notes").Cells(1, 2) = UserNotes
    ActiveSheet.Range("Notes").Cells(1, 2).WrapText = True
    ' Crap fix to get the wrap to work. I noticed that after I inserted another row the previous rows
    ' word wrap property would kick in. So I just add in and delete a row to force that behaviour.
    ActiveSheet.ListObjects("Notes").ListRows.Add (1)
    ActiveSheet.Range("Notes").Item(1).Delete
    Application.ScreenUpdating = True

End Sub

Не кажется идеальным, но он выполняет свою работу, пока я не узнаю, каков правильный ответ.

0 голосов
/ 28 января 2010

Линия 

ActiveSheet.ListObjects("Notes").ListRows.Add (1)

добавляет на лист новые ячейки, которые наследуют их формат из заголовка списка. Итак, вам нужно убедиться, что в ячейках заголовка также включена перенос слов. В качестве альтернативы вы можете добавить свойство word wrap впоследствии, например так: 

 ActiveSheet.Range("Notes").Cells(1, 2).WrapText = true
...