Страницы: 1
RSS
как редактировать поле слияние excel-word
 
Здравствуйте Уважаемые форумчане, прошу подсказать, возможно кто то уже сталкивался с проблемой слияния excel в word После слияния появляется пустая строка после поля, если символов мало, то всё нормально. а вот только как увеличиваю она добавляется, подскажите как избавиться от пустой строки. Заранее благодарен
 
кросс http://www.cyberforum.ru/ms-word/thread2281377.html
 
Казанский,моя тема, там не нашел ответа
Изменено: alex1210 - 03.08.2018 09:05:01
 
alex1210, Вы должны САМИ давать ссылки на другие ресурсы, где ещё разместили свой вопрос.
 
Уберите перевод лишний строки в конце текстаиз источника в данных и не будет пустой строки в word при слиянии!
Если так не получается, по причинам, что криволапый оператор все равно влепит лишнее, то тогда в качестве источника надо брать не просто файл, а запрос  (Datebase Query) к excel таблице и там производить чистку, но это уже другая история.
Изменено: БМВ - 03.08.2018 14:37:16
По вопросам из тем форума, личку не читаю.
 
БМВ, как можно убрать перевод лишний строки? я же копирую с одной ячейки. а попоробней про чистку можно?
Изменено: alex1210 - 03.08.2018 16:14:35
 
Юрий М,извиняюсь я не знал
 
alex1210, у вас в ячейке за всем этим длинным текстом стоит перевод строки, он и передается в Word.
Чистка - это использовнаие SQL синтаксиса в запросе, для удаление лишних знаков.
По вопросам из тем форума, личку не читаю.
 
БМВ, в ячейку данные собираются макросом, можно ли в макрос внести условие чтобы не цеплял ничего лишнего
Код
Function alex1210(r As Range, Optional razd As String = " ")  'коллекция в словаре
    Dim a, I&, ii&, t$, s$, Dic As Object
    Dim el, col
 
    a = r.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For I = 7 To UBound(a, 2) Step 7
            t = a(1, I)
            If Len(Trim(t)) Then
                If Not .Exists(t) Then .Add t, New Collection
                For ii = I - 6 To I - 1
                  If Len(a(1, ii)) Then .Item(t).Add a(1, ii)
                Next
            End If
        Next
    End With
 
    For Each el In Dic.Keys
        For Each col In Dic.Item(el)
            s = s & " " & col
        Next
        s = s & " " & el & " " & razd
    Next
 
    If Len(s) Then alex1210 = Left(s, Len(s) - Len(razd))
 
End Function
У Николая павлова нашел две UDF а как их внедрить фиг знает
Код
'удаление всех лишних пробелов --------------------------------------------------------------------------------------------------------------------
    If optTrim Then

        On Error Resume Next               'заменяем неразрывный пробел на обычный
        Selection.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        On Error GoTo 0

        For Each cell In DataRng
            cell.Value = WorksheetFunction.Trim(cell.Value)
        Next cell
    End If

    'удаление непечатаемых символов  --------------------------------------------------------------------------------------------------------------------
    If optClean Then
        On Error Resume Next               'заменяем неразрывный пробел на обычный
        Selection.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        On Error GoTo 0

        For Each cell In DataRng
            cell.Value = WorksheetFunction.Clean(cell.Value)
        Next cell
    End If
 
После
Код
If Len(s) Then alex1210 = Left(s, Len(s) - Len(razd))
записать
Код
alex1210 = replace(Application.Clean(alex1210),Chr(10),"")
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,спасибо большое, у коды удаления лишних пробелов и непечатных символов не надо добавлять в тело макроса?
 
Цитата
alex1210 написал:
коды удаления лишних пробелов и непечатных символов не надо добавлять в тело макроса
это Вам решать, а вот к №10 у меня вопрос может  к Дмитрию, а може к ТС.  Там удаляются все переводы строк, в том числе которые внутри, нужны они или нет - вопрос к ТС, а вот если нужны, то имеет смысл проверить последний символ и удалять его если он 10.
По вопросам из тем форума, личку не читаю.
 
БМВ,я просто пробовал объединить, вставил его перед

Код
 Next
  
    If Len(s) Then alex1210 = Left(s, Len(s) - Len(razd))
  
End Function
он ругается на
Код
Next
 
Изменено: alex1210 - 03.08.2018 18:31:19
 
alex1210,  в вашем случае достаточно нескольких replace
Если есть у вас неразрывный пробел и он вам не нужен, то тогда
Код
alex1210 = replace(alex1210,Chr(160)," ")
двойные пробелы - сложенее тут на помощь приходит Trim листовый
Код
alex1210=application.worksheetfunction,trim(alex1210)
Двойные переводы строк
Код
alex1210 = replace(alex1210,Chr(10)&Chr(10),Chr(10))
от тройных  не спасет
...….


Дмитрий(The_Prist) Щербаков, Дмитрий. только сейчас обратил внимание, а это что?
Код
Application.Clean(alex1210),
Изменено: БМВ - 04.08.2018 07:59:17
По вопросам из тем форума, личку не читаю.
 
БМВ, Вы имеете ввиду воттак?
Код
Function alex1210(r As Range, Optional razd As String = " ")  'коллекция в словаре
    Dim a, I&, ii&, t$, s$, Dic As Object
    Dim el, col
  
    a = r.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For I = 7 To UBound(a, 2) Step 7
            t = a(1, I)
            If Len(Trim(t)) Then
                If Not .Exists(t) Then .Add t, New Collection
                For ii = I - 6 To I - 1
                  If Len(a(1, ii)) Then .Item(t).Add a(1, ii)
                Next
            End If
        Next
    End With
  
    For Each el In Dic.Keys
        For Each col In Dic.Item(el)
            s = s & " " & col
        Next
        s = s & " " & el & " " & razd
    Next
  
    If Len(s) Then alex1210 = Left(s, Len(s) - Len(razd))
  alex1210 = replace(alex1210),Chr(160)," ")
alex1210=application.worksheetfunction,trim(alex1210)
alex1210 = replace(alex1210),Chr(10)&Chr(10),Chr(10))
End Function
 
типа того, но только в том случае если вам это надо. ну и конечно про последний перевод строки не забывайте
типа
Код
if right(alex1210;1)=chr(10) then alex1210=left(alex1210;Len(alex1210)-1)
Изменено: БМВ - 03.08.2018 19:01:24
По вопросам из тем форума, личку не читаю.
 
БМВ, не получается, сразу выводит ошибку и выделяет запятую после (alex1210)
 
Цитата
БМВ написал:
а это что?
это вызов функции листа CLEAN.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
alex1210,  это я тормоз,запятые а не точки с запятой.
Код
If Right(alex1210, 1) = Chr(10) Then alex1210 = Left(alex1210, Len(alex1210) - 1)


Цитата
Дмитрий(The_Prist) Щербаков написал:
листа CLEAN
точно, так дано не применял что и забыл, да еще без worksheetfunction  сразу не признал
Изменено: БМВ - 03.08.2018 21:27:19
По вопросам из тем форума, личку не читаю.
 
БМВ,подскажите, коды показывают ошибку и выделяют запятую перед первым Chr(10)
Код
alex1210 = replace(alex1210),Chr(10)&Chr(10),Chr(10))  
alex1210=application.worksheetfunction,trim(alex1210)
alex1210 = replace(alex1210),Chr(10)&Chr(10),Chr(10))
 
Дмитрий(The_Prist) Щербаков, спасибо огромное, вроде не цепляет лишнее, лишняя строка исчезла
 
alex1210, там скобка была лишняя. при копировании влетела и не убрал я сослепу.
По вопросам из тем форума, личку не читаю.
 
БМВ, убрал и все равно ошибка и показывает на запятую
 
alex1210=application.worksheetfunction,trim(alex1210)
должно быть
alex1210=application.worksheetfunction.trim(alex1210)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,спасибо, подправил
Страницы: 1
Наверх