Private Sub Test() 'VB6 (Word 2000)
iText$ = "Макрос для работы с текстом"
iMassiv = Split(iText$, " ")
For iCount% = UBound(iMassiv) To LBound(iMassiv) Step -1
iNewText$ = iNewText$ & " " & iMassiv(iCount%)
Next
MsgBox "Старый текст : " & iText$ & _
vbNewLine & "Новый текст : " & iNewText$, vbOKOnly, ""
End Sub
Макрос для работы с текстом в Word
Помогите сделать макрос:
Дан текст (одна строка) в Word. Изменить порядок слов в этом тексте на обратный и расположить преобразованный текст на следующей строке.
С VBA столкнулся впервые, поэтому только начал изучать! Проблема в том, что не знаю как считать текст в переменную и изменить порядок слов!
Дан текст (одна строка) в Word. Изменить порядок слов в этом тексте на обратный и расположить преобразованный текст на следующей строке.
С VBA столкнулся впервые, поэтому только начал изучать! Проблема в том, что не знаю как считать текст в переменную и изменить порядок слов!
Чтение выделенного на экране текста производится через глобальный объект Selection.Обращение к отдельным словам производится через свойство Words (как ни странно :) ).
Если абстрагироваться от об'ектной модели MS Word, то в "чистом" виде Ваша программа может выглядить так :
Надеюсь, что теперь количество составляющих в Вашей задаче уменьшится.
Код:
Надеюсь, что теперь количество составляющих в Вашей задаче уменьшится.
Спасибо за помощь!
Дополнительное задание:
В тексте с изменённым порядком слов первая буква должна быть большой, а последняя маленькой!
В тексте с изменённым порядком слов первая буква должна быть большой, а последняя маленькой!
Можно например так (но строка должна содержать не менее двух символов) :
Код:
iText$ = "новый ТексТ"
iNewText$ = UCase(Left(iText$, 1)) & Mid(iText$, 2, Len(iText$) - 2) & LCase(Right(iText$, 1))
iNewText$ = UCase(Left(iText$, 1)) & Mid(iText$, 2, Len(iText$) - 2) & LCase(Right(iText$, 1))
Цитата:
Можно например так (но строка должна содержать не менее двух символов) :
При использовании это команды получается, что изменённый текст принимает свой исходный вид! А мне нужно чтобы в первом слове текста с изменённым порядком слов первая буква была большой, а не маленькой, а последняя буква в последнем слове была маленькой, а не большой!
Это шутка ? Если да, то неудачная, если нет, то что мешает просто посмотреть значение переменной iNewText$, а затем разобраться с именами переменных.
Ну вот делаю так:
Текст меняет порядок слов, но первая буква остается маленькой!
А можно этот код переделать для текста, который уже введён в ворде, а не задаётся в самом коде макроса?
Код:
Sub WordsRevers()
iText$ = "Макрос для работы с текстом"
iMassiv = Split(iText$, " ")
For iCount% = UBound(iMassiv) To LBound(iMassiv) Step -1
iNewText$ = iNewText$ & " " & iMassiv(iCount%)
Next
iNewText1$ = UCase(Left(iNewText$, 1)) & Mid(iNewText$, 2, Len(iNewText$) - 2) & LCase(Right(iNewText$, 1))
MsgBox "Старый текст : " & iText$ & _
vbNewLine & "Новый текст : " & iNewText1$, vbOKOnly, ""
End Sub
iText$ = "Макрос для работы с текстом"
iMassiv = Split(iText$, " ")
For iCount% = UBound(iMassiv) To LBound(iMassiv) Step -1
iNewText$ = iNewText$ & " " & iMassiv(iCount%)
Next
iNewText1$ = UCase(Left(iNewText$, 1)) & Mid(iNewText$, 2, Len(iNewText$) - 2) & LCase(Right(iNewText$, 1))
MsgBox "Старый текст : " & iText$ & _
vbNewLine & "Новый текст : " & iNewText1$, vbOKOnly, ""
End Sub
Текст меняет порядок слов, но первая буква остается маленькой!
А можно этот код переделать для текста, который уже введён в ворде, а не задаётся в самом коде макроса?
Не совсем так, после выполнения первого макроса самым первым символом идёт пробел, отсюда и эффект. Кстати, когда я говорил о именах, то подразумевал, что можно было сначала проверить работоспособность инструкции на моём примере, впрочем, сейчас это уже не важно.
Переделать конечно же можно, но для этого нужно знать об’ектную модель MS Word, которую я не шибко хорошо знаю.
Код:
Private Sub WordsRevers() 'VB6 (Word 2000)
iText$ = "Макрос для работы с текстом"
iMassiv = Split(iText$, " ")
For iCount% = UBound(iMassiv) To LBound(iMassiv) Step -1
iNewText$ = iNewText$ & " " & iMassiv(iCount%)
Next
iNewText$ = Trim(iNewText$) 'можно LTrim
iNewText$ = UCase(Left(iNewText$, 1)) & Mid(iNewText$, 2, Len(iNewText$) - 2) & LCase(Right(iNewText$, 1))
MsgBox "Старый текст : " & iText$ & _
vbNewLine & "Новый текст : " & iNewText$, vbOKOnly, ""
End Sub
iText$ = "Макрос для работы с текстом"
iMassiv = Split(iText$, " ")
For iCount% = UBound(iMassiv) To LBound(iMassiv) Step -1
iNewText$ = iNewText$ & " " & iMassiv(iCount%)
Next
iNewText$ = Trim(iNewText$) 'можно LTrim
iNewText$ = UCase(Left(iNewText$, 1)) & Mid(iNewText$, 2, Len(iNewText$) - 2) & LCase(Right(iNewText$, 1))
MsgBox "Старый текст : " & iText$ & _
vbNewLine & "Новый текст : " & iNewText$, vbOKOnly, ""
End Sub
Переделать конечно же можно, но для этого нужно знать об’ектную модель MS Word, которую я не шибко хорошо знаю.
pashulka
Спасибо большое!
Спасибо большое!
Цитата:
Переделать конечно же можно, но для этого нужно знать об’ектную модель MS Word, которую я не шибко хорошо знаю.
А никто здесь не сможет помочь это сделать?
Я знаю :D , правда, методом тыка научного сие изучал...
Selection - выделенный текст как фрагмент документа.
Application - приложение MS Word
ActiveDocument - активный документ (а вы что подумали :) )
И так далее.
Кстати, чтобы считывать фрагмент документа по словам, можно использовать свойство Words (как ни странно...)
Selection - выделенный текст как фрагмент документа.
Application - приложение MS Word
ActiveDocument - активный документ (а вы что подумали :) )
И так далее.
Кстати, чтобы считывать фрагмент документа по словам, можно использовать свойство Words (как ни странно...)
А как реализовать следующее:
Макрос в Word вызывает файл F.xls, в котором находится заранее записанный макрос и передаёт ему управление. Этот макрос получает строчку, меняет слова местами и выводит каждое слово в ячейке.
Вот, что сделал я:
в макросе, который выполянется в Word для выделенного текста следующий код:
Dim e As Object
Dim s As String
s = Selection.Range.Text
Set e = CreateObject("Excel.Application")
e.workbooks.Open ("D:\F.xls")
e.Visible = True
e.Run "WordRevers", s
Set e = Nothing
Т.е. он открывает файл F.xls и запускает макрос WordRevers. А что теперь прописать в этом макросе для того чтобы он изменил порядок слов выделенного текста в Word и вставил каждое слово текста с изменённым порядком слов в отдельную ячейку?
Макрос в Word вызывает файл F.xls, в котором находится заранее записанный макрос и передаёт ему управление. Этот макрос получает строчку, меняет слова местами и выводит каждое слово в ячейке.
Вот, что сделал я:
в макросе, который выполянется в Word для выделенного текста следующий код:
Dim e As Object
Dim s As String
s = Selection.Range.Text
Set e = CreateObject("Excel.Application")
e.workbooks.Open ("D:\F.xls")
e.Visible = True
e.Run "WordRevers", s
Set e = Nothing
Т.е. он открывает файл F.xls и запускает макрос WordRevers. А что теперь прописать в этом макросе для того чтобы он изменил порядок слов выделенного текста в Word и вставил каждое слово текста с изменённым порядком слов в отдельную ячейку?
Подробнее, на каком листе, в какие ячейки и.т.п.
А вообще-то удовольствия мало - жонглировать макросами в разных приложениях. Ты можешь прямо из Ворда не только открыть файл в Экселе, но и менять там ячейки сколько угодно. Вообще почти всё, что ты можешь сделать в Экселевском макросе, ты можешь сделать из Ворда, и наоборот.
А вообще-то удовольствия мало - жонглировать макросами в разных приложениях. Ты можешь прямо из Ворда не только открыть файл в Экселе, но и менять там ячейки сколько угодно. Вообще почти всё, что ты можешь сделать в Экселевском макросе, ты можешь сделать из Ворда, и наоборот.
Цитата:
Подробнее, на каком листе, в какие ячейки и.т.п.
На первом листе в первых верхних ячейках (не столбцом, а в строчку)!
А тебе так важно, чтобы кусочек макроса находился в Экселе? Давай сделаем, что он весь будет находится в Ворде. Так будет понятней и надёжней.
Да, важно, в этом-то и проблема!
А что именно у тебя вызывает сложность? Перестановка слов или размещение слов по ячейкам?
Сбой. Сообщение продублировалось.
Вот решение вашей проблемы
Код:
Sub Macro8()
'
' Macro8 Macro
' Macro recorded þ21/11/2006 by *
'
Dim word1, word2, word3 As String
Dim xx1, xx2, xx3 As Integer
Selection.HomeKey Unit:=wdLine
ActiveDocument.Paragraphs(1).Range.Select
xx1 = InStr(1, Trim(ActiveDocument.Paragraphs(1)), " ")
word3 = Mid(Trim(ActiveDocument.Paragraphs(1)), 1, xx1 - 1)
'MsgBox word3
xx2 = InStr(xx1 + 1, Trim(ActiveDocument.Paragraphs(1)), " ")
word2 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx1 + 1, (xx2) - (xx1 + 1))
'MsgBox word2
xx3 = Len(Trim(ActiveDocument.Paragraphs(1)))
word1 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx2 + 1, (xx3) - (xx2 + 1))
'MsgBox word1
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText (word1 & " " & word2 & " " & word3)
End Sub
'
' Macro8 Macro
' Macro recorded þ21/11/2006 by *
'
Dim word1, word2, word3 As String
Dim xx1, xx2, xx3 As Integer
Selection.HomeKey Unit:=wdLine
ActiveDocument.Paragraphs(1).Range.Select
xx1 = InStr(1, Trim(ActiveDocument.Paragraphs(1)), " ")
word3 = Mid(Trim(ActiveDocument.Paragraphs(1)), 1, xx1 - 1)
'MsgBox word3
xx2 = InStr(xx1 + 1, Trim(ActiveDocument.Paragraphs(1)), " ")
word2 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx1 + 1, (xx2) - (xx1 + 1))
'MsgBox word2
xx3 = Len(Trim(ActiveDocument.Paragraphs(1)))
word1 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx2 + 1, (xx3) - (xx2 + 1))
'MsgBox word1
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText (word1 & " " & word2 & " " & word3)
End Sub
Ну, уважаемый Tever, Вы невнимательно читали предыдущие посты.
А я всё пытаюсь раскрутить товарища MoMa на нормальное общение. А то он пишет по две строчки в неделю.
А я всё пытаюсь раскрутить товарища MoMa на нормальное общение. А то он пишет по две строчки в неделю.
Я прочитал первый пост и выполнил все требования :)
Версия исправленная и дополненая для Worda
Код:
Sub Macro8()
'
' Macro8 Macro
' Macro recorded ю21/11/2006 by *
'
Dim word1, word2, word3 As String
Dim xx1, xx2, xx3 As Integer
Selection.HomeKey Unit:=wdLine
ActiveDocument.Paragraphs(1).Range.Select
xx1 = InStr(1, Trim(ActiveDocument.Paragraphs(1)), " ")
word3 = Mid(Trim(ActiveDocument.Paragraphs(1)), 1, xx1 - 1)
'MsgBox word3
xx2 = InStr(xx1 + 1, Trim(ActiveDocument.Paragraphs(1)), " ")
word2 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx1 + 1, (xx2) - (xx1 + 1))
'MsgBox word2
xx3 = Len(Trim(ActiveDocument.Paragraphs(1)))
word1 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx2 + 1, (xx3) - (xx2 + 1))
word1 = UCase(Left(word1, 1)) & Mid(word1, 2, Len(word1) - 1)
'MsgBox word1
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText (word1 & " " & LCase(word2) & " " & LCase(word3))
' Если необходимо второе и третье слова оставить в прежнем регистре надо убрать
'функцию LCase вот так:
'Selection.TypeText (word1 & " " & word2 & " " & word3)
End Sub
'
' Macro8 Macro
' Macro recorded ю21/11/2006 by *
'
Dim word1, word2, word3 As String
Dim xx1, xx2, xx3 As Integer
Selection.HomeKey Unit:=wdLine
ActiveDocument.Paragraphs(1).Range.Select
xx1 = InStr(1, Trim(ActiveDocument.Paragraphs(1)), " ")
word3 = Mid(Trim(ActiveDocument.Paragraphs(1)), 1, xx1 - 1)
'MsgBox word3
xx2 = InStr(xx1 + 1, Trim(ActiveDocument.Paragraphs(1)), " ")
word2 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx1 + 1, (xx2) - (xx1 + 1))
'MsgBox word2
xx3 = Len(Trim(ActiveDocument.Paragraphs(1)))
word1 = Mid(Trim(ActiveDocument.Paragraphs(1)), xx2 + 1, (xx3) - (xx2 + 1))
word1 = UCase(Left(word1, 1)) & Mid(word1, 2, Len(word1) - 1)
'MsgBox word1
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText (word1 & " " & LCase(word2) & " " & LCase(word3))
' Если необходимо второе и третье слова оставить в прежнем регистре надо убрать
'функцию LCase вот так:
'Selection.TypeText (word1 & " " & word2 & " " & word3)
End Sub
Цитата:
что именно у тебя вызывает сложность? Перестановка слов или размещение слов по ячейкам?
Сложность вызывает перестановка слов. Не знаю, что в цикле прописать.
Следующий код для перестановки слов я использовал в вордовском макросе:
Код:
For i = Selection.Range.Words.Count To 1 Step -1
s = s & " " & Selection.Range.Words(i).Text
s = Trim(s)
Next
s = s & " " & Selection.Range.Words(i).Text
s = Trim(s)
Next
А вот как его переделать под екселевский макрос?..
[quote=Tever]Вот решение вашей проблемы[/quote]
Спасибо, конечно, но первое задание я уже сделал! А сейчас мне нужна помощь в решении этого задания:
Цитата:
А как реализовать следующее:
Макрос в Word вызывает файл F.xls, в котором находится заранее записанный макрос и передаёт ему управление. Этот макрос получает строчку, меняет слова местами и выводит каждое слово в ячейке.
Вот, что сделал я:
в макросе, который выполянется в Word для выделенного текста следующий код:
Dim e As Object
Dim s As String
s = Selection.Range.Text
Set e = CreateObject("Excel.Application")
e.workbooks.Open ("D:\F.xls")
e.Visible = True
e.Run "WordRevers", s
Set e = Nothing
Т.е. он открывает файл F.xls и запускает макрос WordRevers. А что теперь прописать в этом макросе для того чтобы он изменил порядок слов выделенного текста в Word и вставил каждое слово текста с изменённым порядком слов в отдельную ячейку?
Макрос в Word вызывает файл F.xls, в котором находится заранее записанный макрос и передаёт ему управление. Этот макрос получает строчку, меняет слова местами и выводит каждое слово в ячейке.
Вот, что сделал я:
в макросе, который выполянется в Word для выделенного текста следующий код:
Dim e As Object
Dim s As String
s = Selection.Range.Text
Set e = CreateObject("Excel.Application")
e.workbooks.Open ("D:\F.xls")
e.Visible = True
e.Run "WordRevers", s
Set e = Nothing
Т.е. он открывает файл F.xls и запускает макрос WordRevers. А что теперь прописать в этом макросе для того чтобы он изменил порядок слов выделенного текста в Word и вставил каждое слово текста с изменённым порядком слов в отдельную ячейку?
Маленький вопросик: а что, если слов не три?
А их не три, их сколько введёшь, столько и будет!
Некорректная постановка задачи!!!
Сформулируйте, пожалуйста вашу задачу заново
Сформулируйте, пожалуйста вашу задачу заново
А что именно?
Я все перечитал и, как мне кажется, понял.
Надеюсь в ближайшие дни дать ответ
Надеюсь в ближайшие дни дать ответ
Это макрос для Word'a
Это макрос для Excel'a
У меня все работает
Код:
Sub Macro9()
Dim e As Object
Dim s As String
s = Selection.Range.Text
z = Selection.Range.Words.Count
If Asc(Right(s, 1)) = 13 Then
s = Left(s, Len(s) - 1)
z = Selection.Range.Words.Count - 1
End If
Set e = CreateObject("Excel.Application")
e.workbooks.Open ("D:\F.xls")
e.Visible = True
x = e.Run("WordReverts", Trim(s), z)
Set e = Nothing
End Sub
Dim e As Object
Dim s As String
s = Selection.Range.Text
z = Selection.Range.Words.Count
If Asc(Right(s, 1)) = 13 Then
s = Left(s, Len(s) - 1)
z = Selection.Range.Words.Count - 1
End If
Set e = CreateObject("Excel.Application")
e.workbooks.Open ("D:\F.xls")
e.Visible = True
x = e.Run("WordReverts", Trim(s), z)
Set e = Nothing
End Sub
Это макрос для Excel'a
Код:
Sub WordReverts(sss, zzz)
xx1 = 1
For i = 1 To zzz
If i = zzz Then
xx2 = Len(Trim(sss))
word3 = Mid(Trim(sss), xx1, xx2 - xx1)
word3 = UCase(Left(word3, 1)) & Mid(word3, 2, Len(word3) - 1)
Else
xx2 = InStr(xx1, Trim(sss), " ")
word3 = Mid(Trim(sss), xx1, xx2 - xx1)
End If
xx1 = xx2 + 1
If Trim(word3) > 0 Then
Cells(1, zzz - i + 1).Select
ActiveCell.FormulaR1C1 = word3
End If
Next
End Sub
xx1 = 1
For i = 1 To zzz
If i = zzz Then
xx2 = Len(Trim(sss))
word3 = Mid(Trim(sss), xx1, xx2 - xx1)
word3 = UCase(Left(word3, 1)) & Mid(word3, 2, Len(word3) - 1)
Else
xx2 = InStr(xx1, Trim(sss), " ")
word3 = Mid(Trim(sss), xx1, xx2 - xx1)
End If
xx1 = xx2 + 1
If Trim(word3) > 0 Then
Cells(1, zzz - i + 1).Select
ActiveCell.FormulaR1C1 = word3
End If
Next
End Sub
У меня все работает
Tever
Огромнейшее спасибо Вам за помощь!
Огромнейшее спасибо Вам за помощь!
А как теперь сделать тоже самое задание, только текст введён не в ворде, а в Delphi? Т.е. весь код содержится в макросе Excel_я, а работать нужно с тектсом, который введён в Delphi.
Никто не знает?
Здравствуйте форумчане нужна помощь, кто шарит в макросах.
Нужно создать макрос, чтобы при открытия ворда выскакивало окно с вводам пароля и макрос этим паролем активировался, помогите)
Нужно создать макрос, чтобы при открытия ворда выскакивало окно с вводам пароля и макрос этим паролем активировался, помогите)
NeOgAt, Откройте нужный документ и в модуле ThisDocument пропишите и сохраните нижеприведённый вариант, разумеется, указав свой пароль и макрос.
Код:
Private Sub Document_Open()
If InputBox("Введите пароль", "") = "Ваш_пароль" Then Имя_Макроса
End Sub
'Private Sub Document_Open()
' If InputBox("Введите пароль", "") = "Ваш_пароль" Then Application.Run "Имя_Макроса"
'End Sub
If InputBox("Введите пароль", "") = "Ваш_пароль" Then Имя_Макроса
End Sub
'Private Sub Document_Open()
' If InputBox("Введите пароль", "") = "Ваш_пароль" Then Application.Run "Имя_Макроса"
'End Sub
А можете весь код написать, задача состоит в следующем: нужно написать пять штук макросов, при заходе в документ должно выскакивать поле для ввода пароля, и чтобы каждый пароль активировал свой макрос. А если пароль введен не верно то вылезало соответственное окно что пароль не верный. Опишите все поподробнее).Для ворда.
Я, собственно, весь код и написал, просто в случае с пятью паролями имеет смысл использовать Select Case ... т.е.
Код:
Private Sub Document_Open()
Select Case InputBox("Введите пароль", "")
Case "Пароль1": Имя_Макроса1
Case "Пароль2": Имя_Макроса2
Case "Пароль3": Имя_Макроса3
Case "Пароль4": Имя_Макроса4
Case "Пароль5": Имя_Макроса5
Case Else: MsgBox "Неверно введён пароль", vbCritical, ""
End Select
End Sub
Select Case InputBox("Введите пароль", "")
Case "Пароль1": Имя_Макроса1
Case "Пароль2": Имя_Макроса2
Case "Пароль3": Имя_Макроса3
Case "Пароль4": Имя_Макроса4
Case "Пароль5": Имя_Макроса5
Case Else: MsgBox "Неверно введён пароль", vbCritical, ""
End Select
End Sub
Спасибо вам огромное, нужно еще кое-что: если пароль введен не верно окно вылазит, что пароль не верен и пользователь щелкая на ок, документ закрывался автоматически). И еще необходимо поставить пароль на редактирование документа, чтобы он толь читался ну и все вот это выполнялось и другой пользователь не мог посмотреть код программы.
1) Для того, чтобы закрыть документ без изменений, достаточно после функции MsgBox добавить метод .Close об'екта Document, т.е.
или
2) Word97-2003 Попробуйте использовать меню Сервис, команда Установить защиту и второй или третий переключатель.
3) Word97-2003 ALT+F11 - Tools - Normal Properties - Protection - Lock Project for viewing - Password - Confirm password
P.S. Правда существуют программы, которые определяют офисные пароли, так что говорить о сурьёзной защите кода макроса, не приходится :(
Код:
MsgBox "Неверно введён пароль", vbCritical, "": Me.Close wdDoNotSaveChanges
Код:
MsgBox "Неверно введён пароль", vbCritical, "": ThisDocument.Close wdDoNotSaveChanges
3) Word97-2003 ALT+F11 - Tools - Normal Properties - Protection - Lock Project for viewing - Password - Confirm password
P.S. Правда существуют программы, которые определяют офисные пароли, так что говорить о сурьёзной защите кода макроса, не приходится :(
Спасибо, теперь получилось, но остался последний штрих другой пользователь не должен видеть макросов т.е. когда он заходит во вкладку вид, макросы-макросы, он не должен видеть эти все макросы там. Ворд 2010