Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Alex375
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
VBA: не работает функция разбиения строки
 
#
06.06.2018 14:58:18
Изменил ячейку "C16" в Excel файле, теперь там текст превышающий 256 символов. Данная функция Sub Replace() должна "поделить" строку на части и выполнить пошаговую вставку ее в шаблон, но она этого не делает.
Изменено: Alex375 - 09.06.2018 08:37:15
 
Перейти    
VBA: не работает функция разбиения строки
 
#
06.06.2018 12:39:27
Добрый день! Имеется макрос, заполняющий шаблон Word документа значениями из ячеек Excel.
В данном макросе есть функция проверки значения в ячейке excel на превышение 256 символов и вставки текста в шаблон Word пошагово, если значение превышает 256 символов:
Код
'Функция проверки и разбиения строки
Sub Replace(Word1, Word2, WD)
    Lencheck = Len(Word2)   'Проверка длины строки для вставки
If Lencheck > MaxLen Then   'Если строка более 256 символов вставку следует выполнить по этапно
    Start = 1
    Lengg = MaxLen          'устанавливаем длину строки для вставки
    Do
        Buffer = Mid(Word2, Start, Lengg) 'режем строку для вставки с позиции Start до Lengg
        Call Replacing(Word1, Buffer, WD)
        Start = Lengg           'меняем стартовую позицию функции Mid
        Lengg = Lengg + MaxLen  'двигаемся далее по строке с шагом MaxLen
    Loop While Lengg < Lencheck 'выполняем пошаговую вставку строки, пока не дойдем до конца
        Buffer = Mid(Word2, Start, Lengg) 'режем строку для вставки с позиции Start до Lengg
        Call Replacing(Word1, Buffer, WD)

Else 'замена Word1 на Word2 при условии, что Word2 - текст для замены - короче 256 символов
    Call Replacing(Word1, Word2, WD)
End If

End Sub
Но данная функция не работает. В чем может быть проблема? Заранее спасибо.
 
Перейти    
VBA: избавиться от повтора одинаковой функции
 
#
04.06.2018 15:00:56
Я наверное неправильно написал, мне нужно чтобы для каждого нового поиска слова, надо было не копировать и вставлять заново этот кусок кода:  
Код
Set r = WordDoc.Range
Do
With r.Find
    .ClearFormatting
    .Text = "дисциплина *относится"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
                If f Then
                    If r.Start = fO Then
                Exit Do
                    End If
                Else
                    fO = r.Start
                    f = True
                End If
                WordDoc.Range(r.Start + 11, r.End - 9).Copy
                Range("C4").Select
                Range("B4").Value = "Название дисциплины"
                ActiveSheet.Paste
                Set r = WordDoc.Range(r.End, r.End)
            Else
                Exit Do
            End If
        End With
    Loop
А чтобы поиск был только один, а разные данные для поиска:
Код
.Text = "дисциплина *относится"

и вставки:
Код
WordDoc.Range(r.Start + 11, r.End - 9).Copy                
Range("C4").Select
Range("B4").Value = "Название дисциплины"
ActiveSheet.Paste
Заносились бы туда автоматически.
 
Перейти    
VBA: избавиться от повтора одинаковой функции
 
#
04.06.2018 11:54:56
Добрый день. У меня есть код, который выполняет поиск слов "по их окружению" в Word файле с помощью макроса в Excel и вставляет их в определенные ячейки. Но код повторяет одну и ту же функцию поиска несколько раз:
Код
'''Наименование дисциплины'''
Set r = WordDoc.Range
Do
With r.Find
    .ClearFormatting
    .Text = "дисциплина *относится"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
                If f Then
                    If r.Start = fO Then
                Exit Do
                    End If
                Else
                    fO = r.Start
                    f = True
                End If
                WordDoc.Range(r.Start + 11, r.End - 9).Copy
                Range("C4").Select
                Range("B4").Value = "Название дисциплины"
                ActiveSheet.Paste
                Set r = WordDoc.Range(r.End, r.End)
            Else
                Exit Do
            End If
        End With
    Loop

'''Цель'''
Set r = WordDoc.Range
Do
With r.Find
    .ClearFormatting
    .Text = "дисциплины – * сформировать"
    .Forward = True    
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
                If f Then
                    If r.Start = fO Then
                Exit Do
                    End If
                Else
                    fO = r.Start
                    f = True
                End If
                WordDoc.Range(r.Start + 13, r.End - 13).Copy
                Range("C6").Select
                Range("B6").Value = "Цель дисциплины"
                ActiveSheet.Paste
                Set r = WordDoc.Range(r.End, r.End)
            Else
                Exit Do
            End If
        End With
    Loop
   
End Sub

Как мне сократить этот код (избавиться от повтора функции)?
Изменено: Alex375 - 04.06.2018 16:27:47
 
Перейти    
Страницы: 1
Наверх