Макросы

[maik]

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

Напишите макрос, который создает новую панель инструментов
«успеваемость» в составе: 3 поля ввода, 2 списка выбора, кнопка.
В поля ввода поместить ФИО ученика, выбрать из списка название
учебного предмета из перечня (физика, математика, химия, биология,
литература, история), выбрать оценку из списка
(неудовлетворительно, удовлетворительно, хорошо, отлично).
После нажатия на кнопку добавить в текущий документ отчет об
успеваемости ученика по указанному предмету в виде переложения:
«Ученик ФИО получил ** по предмету **» (вместо ** подставить
значения, выбранные в панели инструментов).

[Viper]

в раздел Работа?

[maik]

блин ну че не кто помочь не может что-ли???

[alibek]

Интересно, в чем выражается помощь?
Помощь -- это когда ты сам что-то делаешь, но что-то не получается.
В твоем же посте не видно даже попытки сделать что-либо самостоятельно.

[maik]

хотябы намекните как это делать

[alibek]

Что нужно делать, у тебя написано в задании.
Или ты его даже не читал, когда сюда постил?

[maik]

вы че такие люди, а!!!! , в ручную я могу создать панель инструментов а с макросом нет

[alibek]

Запиши макрос и изучай код.

[Krasnaja Shapka]

Tools/Macro/Record new macro
Инструменты/Макрос/Запись нового макроса

[maik]

может подскажите почему когда я в TextBox набрал текст и перехожу на другой TextBox у меня надписи в первом исчезают.


Dim Uspevaemost As CommandBar
Set Uspevaemost = CommandBars.Add

Uspevaemost.Name = "Uspevaemost"
Uspevaemost.Enabled = True
Uspevaemost.Position = msoBarTop
Uspevaemost.Visible = True

Dim TextBox1 As CommandBarControl
Set TextBox1 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox1.DescriptionText = "Фамилия"

Dim TextBox2 As CommandBarControl
Set TextBox2 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox2.DescriptionText = "Имя"

Dim TextBox3 As CommandBarControl
Set TextBox3 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox3.DescriptionText = "Отчество"

Dim Menu As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Компоненты дата и времени"
Menu.AddItem "Предметы"
Menu.AddItem "Физика"
Menu.AddItem "Математика"
Menu.AddItem "Химия"
Menu.AddItem "Биология"
Menu.AddItem "Литература"
Menu.AddItem "История"
Menu.ListIndex = 1
Menu.Width = 190

Dim Menu2 As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Оценка"
Menu.AddItem "Оценка"
Menu.AddItem "отлично"
Menu.AddItem "хорошо"
Menu.AddItem "удов."
Menu.AddItem "не удов."
Menu.ListIndex = 1
Menu.Width = 190
End Sub

[alibek]

Потому что ввод надо подтверждать нажатием Enter.

[maik]

спасибо!!, а по другому ни как нельзя?????

[alibek]

Судя по всему, нет.
Попробуй заменить TextBox на ComboBox. У последнего есть событие Change, возможно в нем можно будет отловить факт изменения текста.

[maik]

ок!!, может посмотрите в чем ошибка, не могу добавить данные, и как сделать: «Ученик ФИО получил ** по предмету **» (вместо ** подставить значения, выбранные в панели инструментов).

Sub Nikitsov()

Dim Uspevaemost As CommandBar
Set Uspevaemost = CommandBars.Add

Uspevaemost.Name = "Uspevaemost"
Uspevaemost.Enabled = True
Uspevaemost.Position = msoBarTop
Uspevaemost.Visible = True

Dim text As String
Dim TextBox1 As CommandBarControl
Set TextBox1 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox1.DescriptionText = "Ôàìèëèÿ"


Dim TextBox2 As CommandBarControl
Set TextBox2 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox2.DescriptionText = "Èìÿ"

Dim TextBox3 As CommandBarControl
Set TextBox3 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox3.DescriptionText = "Îò÷åñòâî"

Dim Menu As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Êîìïîíåíòû äàòà è âðåìåíè"
Menu.AddItem "Ïðåäìåòû"
Menu.AddItem "Ôèçèêà"
Menu.AddItem "Ìàòåìàòèêà"
Menu.AddItem "Õèìèÿ"
Menu.AddItem "Áèîëîãèÿ"
Menu.AddItem "Ëèòåðàòóðà"
Menu.AddItem "Èñòîðèÿ"
Menu.ListIndex = 1
Menu.Width = 190

Dim Menu2 As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Îöåíêà"
Menu.AddItem "Îöåíêà"
Menu.AddItem "îòëè÷íî"
Menu.AddItem "õîðîøî"
Menu.AddItem "óäîâ."
Menu.AddItem "íå óäîâ."
Menu.ListIndex = 1
Menu.Width = 190

Dim Button1 As CommandBarButton
Set Button1 = Uspevaemost.Controls.Add(Type:=msoControlButton)
Button1.Style = msoButtonCaption
Button1.Caption = "Äîáàâèòü"
Button1.OnAction = "Äîáàâèòü"
Button1.OnAction = "Äîáàâèòü1"

End Sub
Sub Äîáàâèòü()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Äîáàâèòü").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Äîáàâèòü äàííûå").Controls(1).ListIndex
Dim q As String
Dim text As String

Select Case Sposob

Case 1: Selection.TypeText text:="Ôèõèêà: " & CStr(Time) & vbNewLine


Case 2: Selection.TypeText text:="Ìàòåìàòèêà: " & vbNewLine

Case 3: Selection.TypeText text:="Õèìèÿ: " & vbNewLine

Case 4: Selection.TypeText text:="Áèîëîãèÿ: " & vbNewLine

Case 5: Selection.TypeText text:="Ëèòåðàòóðà: " & vbNewLine

Case 6: Selection.TypeText text:="Èñòîðèÿ: " & vbNewLine

End Select
On Error GoTo 0

End Sub
Sub Äîáàâèòü1()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Äîáàâèòü").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Äîáàâèòü äàííûå").Controls(1).ListIndex
Dim q As String
Dim text As String
Select Case Sposob

Case 1: Selection.TypeText text:="îòëè÷íî: " & vbNewLine
Case 2: Selection.TypeText text:="õîðîøî: " & vbNewLine
Case 3: Selection.TypeText text:="óäîâ.: " & vbNewLine
Case 4: Selection.TypeText text:="íå óäîâ.: " & vbNewLine

End Sub

[alibek]

Поправь кириллицу, она не читается.
И тэг CODE используй для кода.

[maik]

Ребят! помогите, почему не добовляются данные в Word

Код: Выделить всё

Sub makros()

Dim Uspevaemost As CommandBar
Set Uspevaemost = CommandBars.Add

Uspevaemost.Name = "Uspevaemost"
Uspevaemost.Enabled = True
Uspevaemost.Position = msoBarTop
Uspevaemost.Visible = True

Dim text As String
Dim TextBox1 As CommandBarControl
Set TextBox1 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox1.DescriptionText = "Фамилия"


Dim TextBox2 As CommandBarControl
Set TextBox2 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox2.DescriptionText = "Имя"

Dim TextBox3 As CommandBarControl
Set TextBox3 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox3.DescriptionText = "Отчество"

Dim Menu As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Предметы"
Menu.AddItem "Физика"
Menu.AddItem "Математика"
Menu.AddItem "Химия"
Menu.AddItem "Биология"
Menu.AddItem "Литература"
Menu.AddItem "История"
Menu.Width = 190

Dim Menu2 As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Оценка"
Menu.AddItem "отлично"
Menu.AddItem "хорошо"
Menu.AddItem "удов."
Menu.AddItem "не удов."
Menu.Width = 190

Dim Button1 As CommandBarButton
Set Button1 = Uspevaemost.Controls.Add(Type:=msoControlButton)
Button1.Style = msoButtonCaption
Button1.Caption = "Добавить"
Button1.OnAction = "Добавить"
Button1.OnAction = "Добавить1"

End Sub
Sub Добавить()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Добавить").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Добавить данные").Controls(1).ListIndex
Dim q As String
Dim text As String
Select Case Sposob
Case 1: Selection.TypeText text:="Фихика: &" & Result
Case 2: Selection.TypeText text:="Математика: &" & Result
Case 3: Selection.TypeText text:="Химия:&" & Result
Case 4: Selection.TypeText text:="Биология: &" & Result
Case 5: Selection.TypeText text:="Литература: &" & Result
Case 6: Selection.TypeText text:="История: &" & Result

End Select
On Error GoTo 0

End Sub
Sub Добавить1()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Добавить").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Добавить данные").Controls(1).ListIndex
Dim q As String
Dim text As String
Select Case Sposob
Case 1: Selection.TypeText text:="отлично: &" & Result
Case 2: Selection.TypeText text:="хорошо: &" & Result
Case 3: Selection.TypeText text:="удов.: &" & Result
Case 4: Selection.TypeText text:="не удов.: &" & Result

End Select

End Sub

[/code]

[Viper]

Автор, заюзай же уже тэги!!!! Читать код невозможно.
З.Ы. и чего я здесь (VBA и VB 1 - 6) не модер... (Вопель души)

[alibek]

Разумеется.
Переменная Result у тебя вообще не объявлена, переменные q и text не используются и непонятно для чего нужны.
Тебе нужно что-то вроде этого:

Код: Выделить всё

...
s = "Ученик " & CommandBars("...").Controls(...).Text
s = s & " получил " & Choose(CommandBars("...").Controls(...).ListIndex+1, "отлично", "хорошо", "удовлетворительно", "не удовлетворительно")
s = s & " по предмету " & CommandBars("...").Controls(...).Text
Selection.TypeText s
...

[maik]

подскажите, как сделать пробелы между ФИО, и как вывести со списков????

Код: Выделить всё

Sub Nikitsov()

Dim Uspevaemost As CommandBar
Set Uspevaemost = CommandBars.Add

Uspevaemost.Name = "Uspevaemost"
Uspevaemost.Enabled = True
Uspevaemost.Position = msoBarTop
Uspevaemost.Visible = True

Dim TextBox1 As CommandBarControl
Set TextBox1 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox1.DescriptionText = "Фамилия"


Dim TextBox2 As CommandBarControl
Set TextBox2 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox2.DescriptionText = "Имя"

Dim TextBox3 As CommandBarControl
Set TextBox3 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox3.DescriptionText = "Отчество"

Dim Menu As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Предметы"
Menu.AddItem "Физика"
Menu.AddItem "Математика"
Menu.AddItem "Химия"
Menu.AddItem "Биология"
Menu.AddItem "Литература"
Menu.AddItem "История"
Menu.Width = 190

Dim Menu1 As CommandBarControl
Set Menu1 = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu1.DescriptionText = "Оценка"
Menu1.AddItem "отлично"
Menu1.AddItem "хорошо"
Menu1.AddItem "удов."
Menu1.AddItem "не удов."
Menu1.Width = 190

Dim Button1 As CommandBarButton
Set Button1 = Uspevaemost.Controls.Add(Type:=msoControlButton)
Button1.Style = msoButtonCaption
Button1.Caption = "Добавить"
Button1.OnAction = "Добавить"
Button1.OnAction = "Добавить1"

End Sub
Sub Добавить()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Добавить").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Добавить данные").Controls(1).ListIndex
Dim s As String
Dim q As String
Select Case Sposob
Case 1: Selection.TypeText text:="Фихика: "
Case 2: Selection.TypeText text:="Математика: "
Case 3: Selection.TypeText text:="Химия:"
Case 4: Selection.TypeText text:="Биология: "
Case 5: Selection.TypeText text:="Литература: "
Case 6: Selection.TypeText text:="История: "

End Select
On Error GoTo 0

End Sub
Sub Добавить1()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Добавить").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Добавить данные").Controls(1).ListIndex
Select Case Sposob2
Case 1: Selection.TypeText text:="отлично:"
Case 2: Selection.TypeText text:="хорошо: "
Case 3: Selection.TypeText text:="удов.:"
Case 4: Selection.TypeText text:="не удов.:"

End Select
s = "Ученик " & CommandBars("Uspevaemost").Controls(1).text & CommandBars("Uspevaemost").Controls(2).text & CommandBars("Uspevaemost").Controls(3).text
s = s & " получил " & Choose(CommandBars("Uapevaemost").Controls(1).ListIndex + 1, "отлично", "хорошо", "удов.", "не удов.")
s = s & " по предмету " & CommandBars("Uaspevaemost").Controls(1).text
Selection.TypeText s

End Sub

[Genyaa]

Не по теме... просто бросилось в глаза:

Case 1: Selection.TypeText text:="Фихика: "

[Krasnaja Shapka]

ну а

Case 4: Selection.TypeText text:="не_удов.:"

вывод: забить на вижуал бейсик, и учить русский!

[maik]

может, кто ни будь, подскажет, как сделать, чтобы со всех списков выводилось и между именем фамилию и отчеством были пробелы??

Код: Выделить всё

Sub Nikitsov()

Dim Uspevaemost As CommandBar
Set Uspevaemost = CommandBars.Add

Uspevaemost.Name = "Uspevaemost"
Uspevaemost.Enabled = True
Uspevaemost.Position = msoBarTop
Uspevaemost.Visible = True

Dim TextBox1 As CommandBarControl
Set TextBox1 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox1.DescriptionText = "Фамилия"


Dim TextBox2 As CommandBarControl
Set TextBox2 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox2.DescriptionText = "Имя"

Dim TextBox3 As CommandBarControl
Set TextBox3 = Uspevaemost.Controls.Add(Type:=msoControlEdit)
TextBox3.DescriptionText = "Отчество"

Dim Menu As CommandBarControl
Set Menu = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu.DescriptionText = "Предметы"
Menu.AddItem "Физика"
Menu.AddItem "Математика"
Menu.AddItem "Химия"
Menu.AddItem "Биология"
Menu.AddItem "Литература"
Menu.AddItem "История"
Menu.Width = 190

Dim Menu1 As CommandBarControl
Set Menu1 = Uspevaemost.Controls.Add(Type:=msoControlDropdown)
Menu1.DescriptionText = "Оценка"
Menu1.AddItem "отлично"
Menu1.AddItem "хорошо"
Menu1.AddItem "удов."
Menu1.AddItem "не удов."
Menu1.Width = 190

Dim Button1 As CommandBarButton
Set Button1 = Uspevaemost.Controls.Add(Type:=msoControlButton)
Button1.Style = msoButtonCaption
Button1.Caption = "Добавить"
Button1.OnAction = "Добавить"
Button1.OnAction = "Добавить1"

End Sub
Sub Добавить()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Добавить").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Добавить данные").Controls(1).ListIndex
Dim q As String
Select Case Sposob
Case 1: Selection.TypeText text:="Физика: "
Case 2: Selection.TypeText text:="Математика: "
Case 3: Selection.TypeText text:="Химия:"
Case 4: Selection.TypeText text:="Биология: "
Case 5: Selection.TypeText text:="Литература: "
Case 6: Selection.TypeText text:="История: "

End Select
On Error GoTo 0

End Sub
Sub Добавить1()

On Error Resume Next
Dim i, Count As Integer
Count = CommandBars("Добавить").Controls(1).ListCount

Dim Sposob As Integer
Sposob = CommandBars("Добавить данные").Controls(2).ListIndex
Select Case Sposob
Case 1: Selection.TypeText text:="отлично"
Case 2: Selection.TypeText text:="хорошо "
Case 3: Selection.TypeText text:="удов."
Case 4: Selection.TypeText text:="неудов."

End Select
s = " получил " & CommandBars("Uapevaemost").Controls(5).ListIndex
s = " Ученик " & CommandBars("Uspevaemost").Controls(1).text & CommandBars("Uspevaemost").Controls(2).text & CommandBars("Uspevaemost").Controls(3).text
s = s & " по предмету " & CommandBars("Uaspevaemost").Controls(4).text
Selection.TypeText s

End Sub


[Genyaa]

maik

может, кто ни будь, подскажет, как сделать, чтобы со всех списков выводилось и между именем фамилию и отчеством были пробелы??

Да, с удвольствием... опишите суть решаемого, структуру обрабатываемых данных и добавьте достаточные для понимания Вашего кода коментарии... Тогда все будет ясно... А без этого напрягаться и заниматься отгадыванием того, что и как делает Ваш макрос мало кому захочется, как мне кажется.

[alibek]

maik, попробуй подумать, что в коде означает символ &. И что будет, если написать & " ".