Бодрого дня. Нашел макрос калькулятора, поправил под себя. Никак не пойму почему скобки считает не правильно :(
Макрос вычисляет выделенный текст в ворде: 2+2*2 Calc_go1()
Но беда со скобками
[vba]
Код
Dim Text1 As String
Sub Calc_go1() Dim lst(), lst2() As String Dim lst3(), summ1 As Double Dim AWind As Window Dim APane As Pane Dim Pages As Pages Dim Page As Page Dim Rect As Rectangle Dim Ssel1 As Selection Dim dssel1, dssel2, dssel3, indx_mas As Integer Dim str_ssel1, str_ssel2, str_ssel3, str_ssel4, str_out1, str_out2, str_out3 As String
Dim LineCount As Long 'Dim lst() As Variant Dim Line As Line
Set AWind = Application.ActiveWindow Set Ssel1 = AWind.ActivePane.Selection Text1 = Ssel1 'Calculate Call Calc_v1(Text1) str_out3 = "=" + Text1 With Selection .InsertAfter (str_out3) '.InsertAfter (Chr(13)) End With
'End Sub With Selection .EndKey End With
MsgBox ("сумма " & str_out3) 'вывести на экран 3-ю строку End Sub
Public Sub Calc_v1(Text1 As String) Dim zn(10) As String, txt As String ' объявляем переменные zn для хранение знаков zn(1) = "*": zn(2) = "/": zn(3) = "+": zn(4) = "-": zn(5) = "(": zn(6) = ")" 'Text1 = "2+2*2" Dim raz As Byte ' эта переменная для того что бы происходили действие сначало * / а потом + - raz = 0 ' For i = 1 To Len(Text1) Step 1 ' читаем текст ' DoEvents ' If Mid(Text1, i, 1) = " " Then 'ищем пробелы ' Text1.SetFocus: Text1.SelStart = i - 1: Text1.SelLength = 1: Text1.SelText = "" ' если есть то убираем ' End If ' Next i
Text1 = "(" & Text1 & ")" ' ставим в скобки они мне нужны txt = "" ' чистим переменную For i = 1 To Len(Text1) Step 1 'читаем текст For zn1 = 1 To 6 Step 1 ' перечисляем знаки If Mid(Text1, i, 1) = zn(zn1) Then txt = txt & " " & zn(zn1) & " ": GoTo qw ' если есть то ставим пробелы возле знаков Next zn1 txt = txt & Mid(Text1, i, 1) ' если нету то просто записывает символ qw: Next i Text1 = txt ' записываем в text переменную txt razz: zad: For i = 1 To Len(Text1) Step 1 ' читаем текст DoEvents ' чтобы не зацикливался If raz = 0 Then 'если первый раз проходит If Mid(Text1, i, 1) = zn(1) Then Call mn(i, "*"): GoTo zad ' то делаем действие * If Mid(Text1, i, 1) = zn(2) Then Call mn(i, "/"): GoTo zad ' и / Else ' иначе If Mid(Text1, i, 1) = zn(3) Then Call mn(i, "+") GoTo zad 'делаем действие + End If If Mid(Text1, i, 1) = zn(4) Then Call mn(i, "-"): GoTo zad ' и - End If Next i If raz = 0 Then raz = 1: GoTo razz ' если первый раз то делаем второй круг Text1 = Mid(Text1, 4, Len(Text1) - 6) ' убираем скобки 'MsgBox (Text1) End Sub Function mn(ByVal i1 As Integer, znak As String) ' что бы воспользоваться функцией надо указать позицию в тексте и у казать знак действие например mn(3,"*") Dim ss1 As Double, ss2 As Double, sn As Integer, sk As Integer ' записываем переменные ss1 число перед знаком, sn её позиция то есть начало ,ss2 второе число после знака , sk позиция второго числа то есть конец Dim zn(10) As String 'объявляем переменные zn для хранение знаков zn(1) = "*": zn(2) = "/": zn(3) = "+": zn(4) = "-": zn(5) = "(": zn(6) = ")" ss1 = 0: ss2 = 0 ' онулируем переменные чисел For s1 = i1 - 1 To 1 Step -1 ' читаем текст от знака до начало For zn1 = 1 To 6 Step 1 'ищем знаки( * / + - ( ) ) If Mid(Text1, s1, 1) = zn(zn1) Then ' сравниваем знаки с символом 'если символ это один из знаков то sn = s1 ' записываем позицию If Mid(Text1, s1, 1) = "(" Then s1 = s1 + 1 ' тут была ошибка когда была скобка я её избежал ss1 = Val(Mid(Text1, s1, i1 - s1)) ' записываем число в переменную GoTo выход1 ' выходим из цикла (я не использую exit for потому что тут не один цик ) End If Next zn1 Next s1 выход1: For s2 = i1 + 1 To Len(Text1) Step 1 'тут анологично только ищет и записывает второе число после знака For zn1 = 1 To 6 Step 1 If Mid(Text1, s2, 1) = zn(zn1) Then ss2 = Val(Mid(Text1, i1 + 1, s2 - i1)) sk = s2 GoTo выход2 End If Next zn1 Next s2 выход2:
'Text1.SetFocus: Text1.SelStart = sn + 1: Text1.SelLength = sk - sn - 3 ' выделяем число перед знаком знак и число после знака
Text1_zp1 = Mid(Text1, 1, sn + 1) 'Text1_zp2 = Mid(Text1, sn + 2, sk - sn - 3) Text1_zp3 = Mid(Text1, sk - 1)
Select Case znak Case "*": 'Text1.SelText = ss1 * ss2: Text1_zp2 = ss1 * ss2: Case "/": If ss2 <> 0 Then Text1_zp2 = ss1 / ss2: 'Text1.SelText = ss1 / ss2: Case "+": 'Text1.SelText = ss1 + ss2: Text1_zp2 = ss1 + ss2: Case "-": 'Text1.SelText = ss1 - ss2: Text1_zp2 = ss1 - ss2: ' делаем действие между двумя числами от зависимости знака и записываем в это выделенное место число End Select
Text1 = Text1_zp1 + Str(Text1_zp2) + Text1_zp3 i = i1 End Function
[/vba]
Бодрого дня. Нашел макрос калькулятора, поправил под себя. Никак не пойму почему скобки считает не правильно :(
Макрос вычисляет выделенный текст в ворде: 2+2*2 Calc_go1()
Но беда со скобками
[vba]
Код
Dim Text1 As String
Sub Calc_go1() Dim lst(), lst2() As String Dim lst3(), summ1 As Double Dim AWind As Window Dim APane As Pane Dim Pages As Pages Dim Page As Page Dim Rect As Rectangle Dim Ssel1 As Selection Dim dssel1, dssel2, dssel3, indx_mas As Integer Dim str_ssel1, str_ssel2, str_ssel3, str_ssel4, str_out1, str_out2, str_out3 As String
Dim LineCount As Long 'Dim lst() As Variant Dim Line As Line
Set AWind = Application.ActiveWindow Set Ssel1 = AWind.ActivePane.Selection Text1 = Ssel1 'Calculate Call Calc_v1(Text1) str_out3 = "=" + Text1 With Selection .InsertAfter (str_out3) '.InsertAfter (Chr(13)) End With
'End Sub With Selection .EndKey End With
MsgBox ("сумма " & str_out3) 'вывести на экран 3-ю строку End Sub
Public Sub Calc_v1(Text1 As String) Dim zn(10) As String, txt As String ' объявляем переменные zn для хранение знаков zn(1) = "*": zn(2) = "/": zn(3) = "+": zn(4) = "-": zn(5) = "(": zn(6) = ")" 'Text1 = "2+2*2" Dim raz As Byte ' эта переменная для того что бы происходили действие сначало * / а потом + - raz = 0 ' For i = 1 To Len(Text1) Step 1 ' читаем текст ' DoEvents ' If Mid(Text1, i, 1) = " " Then 'ищем пробелы ' Text1.SetFocus: Text1.SelStart = i - 1: Text1.SelLength = 1: Text1.SelText = "" ' если есть то убираем ' End If ' Next i
Text1 = "(" & Text1 & ")" ' ставим в скобки они мне нужны txt = "" ' чистим переменную For i = 1 To Len(Text1) Step 1 'читаем текст For zn1 = 1 To 6 Step 1 ' перечисляем знаки If Mid(Text1, i, 1) = zn(zn1) Then txt = txt & " " & zn(zn1) & " ": GoTo qw ' если есть то ставим пробелы возле знаков Next zn1 txt = txt & Mid(Text1, i, 1) ' если нету то просто записывает символ qw: Next i Text1 = txt ' записываем в text переменную txt razz: zad: For i = 1 To Len(Text1) Step 1 ' читаем текст DoEvents ' чтобы не зацикливался If raz = 0 Then 'если первый раз проходит If Mid(Text1, i, 1) = zn(1) Then Call mn(i, "*"): GoTo zad ' то делаем действие * If Mid(Text1, i, 1) = zn(2) Then Call mn(i, "/"): GoTo zad ' и / Else ' иначе If Mid(Text1, i, 1) = zn(3) Then Call mn(i, "+") GoTo zad 'делаем действие + End If If Mid(Text1, i, 1) = zn(4) Then Call mn(i, "-"): GoTo zad ' и - End If Next i If raz = 0 Then raz = 1: GoTo razz ' если первый раз то делаем второй круг Text1 = Mid(Text1, 4, Len(Text1) - 6) ' убираем скобки 'MsgBox (Text1) End Sub Function mn(ByVal i1 As Integer, znak As String) ' что бы воспользоваться функцией надо указать позицию в тексте и у казать знак действие например mn(3,"*") Dim ss1 As Double, ss2 As Double, sn As Integer, sk As Integer ' записываем переменные ss1 число перед знаком, sn её позиция то есть начало ,ss2 второе число после знака , sk позиция второго числа то есть конец Dim zn(10) As String 'объявляем переменные zn для хранение знаков zn(1) = "*": zn(2) = "/": zn(3) = "+": zn(4) = "-": zn(5) = "(": zn(6) = ")" ss1 = 0: ss2 = 0 ' онулируем переменные чисел For s1 = i1 - 1 To 1 Step -1 ' читаем текст от знака до начало For zn1 = 1 To 6 Step 1 'ищем знаки( * / + - ( ) ) If Mid(Text1, s1, 1) = zn(zn1) Then ' сравниваем знаки с символом 'если символ это один из знаков то sn = s1 ' записываем позицию If Mid(Text1, s1, 1) = "(" Then s1 = s1 + 1 ' тут была ошибка когда была скобка я её избежал ss1 = Val(Mid(Text1, s1, i1 - s1)) ' записываем число в переменную GoTo выход1 ' выходим из цикла (я не использую exit for потому что тут не один цик ) End If Next zn1 Next s1 выход1: For s2 = i1 + 1 To Len(Text1) Step 1 'тут анологично только ищет и записывает второе число после знака For zn1 = 1 To 6 Step 1 If Mid(Text1, s2, 1) = zn(zn1) Then ss2 = Val(Mid(Text1, i1 + 1, s2 - i1)) sk = s2 GoTo выход2 End If Next zn1 Next s2 выход2:
'Text1.SetFocus: Text1.SelStart = sn + 1: Text1.SelLength = sk - sn - 3 ' выделяем число перед знаком знак и число после знака
Text1_zp1 = Mid(Text1, 1, sn + 1) 'Text1_zp2 = Mid(Text1, sn + 2, sk - sn - 3) Text1_zp3 = Mid(Text1, sk - 1)
Select Case znak Case "*": 'Text1.SelText = ss1 * ss2: Text1_zp2 = ss1 * ss2: Case "/": If ss2 <> 0 Then Text1_zp2 = ss1 / ss2: 'Text1.SelText = ss1 / ss2: Case "+": 'Text1.SelText = ss1 + ss2: Text1_zp2 = ss1 + ss2: Case "-": 'Text1.SelText = ss1 - ss2: Text1_zp2 = ss1 - ss2: ' делаем действие между двумя числами от зависимости знака и записываем в это выделенное место число End Select
Text1 = Text1_zp1 + Str(Text1_zp2) + Text1_zp3 i = i1 End Function
Не совсем понятно что этот макрос должен делать. Если просто просчитать выделенное, то можно вместо всего этого кода использовать такой : [vba]
Код
Sub d() With Selection .InsertAfter (" = " & Evaluate(Replace((Selection), vbCr, "", , , vbTextCompare))) End With MsgBox ("сумма " & str_out3) End Sub
[/vba] и получим:
Код
5 + 4 *(2+3) = 25
Да почти забыл - нужно еще подключить библиотеку Microsoft Excel...
Не совсем понятно что этот макрос должен делать. Если просто просчитать выделенное, то можно вместо всего этого кода использовать такой : [vba]
Код
Sub d() With Selection .InsertAfter (" = " & Evaluate(Replace((Selection), vbCr, "", , , vbTextCompare))) End With MsgBox ("сумма " & str_out3) End Sub
[/vba] и получим:
Код
5 + 4 *(2+3) = 25
Да почти забыл - нужно еще подключить библиотеку Microsoft Excel...SLAVICK