Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Появление сообщения MsgBox только при y > y1
 
buchlotnik, спасибо большое. Все работает.
Появление сообщения MsgBox только при y > y1
 
Вот файл.
Появление сообщения MsgBox только при y > y1
 
buchlotnik, подредактировал свой вопрос. Забыл это написать. Необходимо, чтобы при y > y1 выскакивал "MsgBox", а "MsgBox" выскакивает всегда.
Появление сообщения MsgBox только при y > y1
 
Опять я.)) Вот подредактировал свой "Макрос". Теперь что-то понять не могу, почему не правильно выполняется функция:
Код
If y > y1 Then

Необходимо, чтобы при y > y1 выскакивал "MsgBox", а "MsgBox" выскакивает всегда. Уже всю голову сломал, но ничего в голову не приходит. Помогите пожалуйста. Вот весь код:
Код
Public itog

Sub Кнопка2_Щелчок()
    With Sheets("Игрушки")
        x = InputBox("Введите штрих-код", "Поиск штрих-кода")
        If StrPtr(x) = 0 Then End
        x = "*" & x & "*"
        Dim cell As Range
        Set cell = .Columns(3).Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole)
         
        If cell Is Nothing Then
            MsgBox "Штрих-код не найден", vbOKOnly, "Предупреждение"
            Exit Sub
        Else
            y1 = cell.Offset(0, 2) - cell.Offset(0, 10)
            y = InputBox(cell.Offset(0, 1) & vbCrLf & "Введите количество товара" & vbCrLf & "Осталось: " & y1 & " шт.", "Количество товара")
                If y > y1 Then
                MsgBox "Вы указали не верное количество товара" & vbCrLf & "В наличии осталось: " & y1 & " шт." & vbCrLf & "Вы указали: " & y & " шт.", vbOKOnly, "Предупреждение"
                End
                End If
            If StrPtr(y) = 0 Then
                End
            End If
            Z = InputBox("Введите цену товара" & vbCrLf & "Закупочная цена: " & Format(cell.Offset(0, 6), "#,##0.00") & " руб." & vbCrLf & "Цена: " & Format(cell.Offset(0, 7), "#,##0.00") & " руб.", "Цена товара")
            If StrPtr(Z) = 0 Then
                End
            End If
        End If
        
        Dim yy
        yy = MsgBox("Данные введены верно?" & vbCrLf & cell.Offset(0, 1) & vbCrLf & "Колличество: " & y & " шт." & vbCrLf & "Цена: " & Z & " руб.", vbYesNo, "Подтверждение")
        If yy = 6 Then
            cell.Offset(0, 10) = cell.Offset(0, 10) + CDbl(y)
            cell.Offset(0, 9) = cell.Offset(0, 9) + CDbl(Z)
            itog = itog + CDbl(Z)
        Else
            MsgBox "Покупка отменена", vbOKOnly
            End
        End If
        
        If cell.Offset(0, 10) = cell.Offset(0, 2) Then
            With Union(cell.Offset(0, 1), cell.Offset(0, 2)).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
        End If
               
        Dim xx
        xx = MsgBox("Необходимо найти еще один штрих-код?", vbYesNo, "Поиск штрих-кода")
        If xx = 6 Then
            Кнопка2_Щелчок
        Else
            MsgBox "Общая сумма " & itog & " руб.", vbOKOnly
        End If
                
    End With
End Sub
Заранее спасибо.
Изменено: Zelen35 - 23.10.2019 01:16:12
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
vikttur, да может закройте её. Вроде бы кто-то выше писал, что ответ уже в 7-м сообщении был дан.  :)  
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
Дмитрий(The_Prist) Щербаков, спасибо за подсказку. Неплохая идея. Попробую сделать.
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
Юрий М, я конечно извиняюсь, но зачем переформулировать, если вы и так поняли вопрос?)) Давайте название темы поменяю, если это возможно.
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
БМВ,при всем уважении, я же не программист. Есть какие-то минимальные познания в VBA и все. Если бы я все сам умел, то не обращался бы за помощью. Я так понимаю - это нельзя сделать, чтобы в любом "InputBox" при нажатии на "Отмену" отменялось все ранее введенное?
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
Юрий М, да InputBox. Что-то тупанул. Извиняюсь.

Дмитрий(The_Prist) Щербаков,спасибо за помощь, статью осмотрел. Получил для себя определенную информацию. Но этот код:
Код
If StrPtr(x) = 0 Then Exit Sub
не совсем то что надо.
Он не отменят макрос, а просто закрывает, а необходимо, чтобы при нажатии на кнопку "Отмена" отменялось все что было введено во всех "InputBox" и закрывался макрос.
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
Юрий М, да InputBox. Что-то тупанул. Извиняюсь.
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
vikttur, да
Макрос: Почему при нажатии на кнопку "Отмена" выскакивает ошибка, а не отменяется макрос?
 
Здравствуйте. Может кто поможет, почему при нажатии на кнопки "Отмены" на различных этапах макроса выскакивает ошибка, а не отменяется макрос? Вот код:
Код
Public itog

Sub Кнопка2_Щелчок()
    With Sheets("Игрушки")
        x = InputBox("Введите штрих-код", "Поиск штрих-кода")
        If VarType(x) = vbBoolean Then Exit Sub
        x = "*" & x & "*"
        Dim cell As Range
        Set cell = .Columns(3).Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole)
         
        If cell Is Nothing Then
            MsgBox "Штрих-код не найден", vbCritical
            Exit Sub
        Else
            y1 = cell.Offset(0, 2) - cell.Offset(0, 10)
            y = InputBox(cell.Offset(0, 1) & vbCrLf & "Введите количество товара" & vbCrLf & "Осталось: " & y1 & "шт.", "Количество товара")
            If VarType(y) = vbBoolean Then
                Exit Sub
            Else
                cell.Offset(0, 10) = cell.Offset(0, 10) + CDbl(y)
            End If
            Z = InputBox("Введите цену товара" & vbCrLf & "Закупочная цена: " & Format(cell.Offset(0, 6), "#,##0.00") & " руб." & vbCrLf & "Цена: " & Format(cell.Offset(0, 7), "#,##0.00") & " руб.", "Цена товара")
            If VarType(Z) = vbBoolean Then
                Exit Sub
            Else
                cell.Offset(0, 9) = cell.Offset(0, 9) + CDbl(Z)
                itog = itog + CDbl(Z)
            End If
        End If
        
        Dim xx
        xx = MsgBox("Необходимо найти еще один штрих-код?", vbYesNo, "Поиск штрих-кода")
        If xx = 6 Then
            Кнопка2_Щелчок
        Else
            MsgBox "Общая сумма " & itog & " руб.", vbOKOnly
        End If
        
        If cell.Offset(0, 10) = cell.Offset(0, 2) Then
            With Union(cell.Offset(0, 1), cell.Offset(0, 2)).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
        End If
        
    End With
End Sub
Спасибо за помощь.
Макрос: Заливка ячеек при определенных параметрах
 
RAN, спасибо большое. Все работает.
Макрос: Заливка ячеек при определенных параметрах
 
Я так понял, никто не поможет)
Макрос: Заливка ячеек при определенных параметрах
 
Всем привет. Спасибо всем за помощь на предыдущих этапах. Появился новый вопрос. Попытался сам записать макрос и добавить в свой, но ничего не получилось.

Вот код:
Код
Public itog

Sub Кнопка2_Щелчок()
    With Sheets("Игрушки")
        x = InputBox("Введите штрих-код", "Поиск штрих-кода")
        If VarType(x) = vbBoolean Then Exit Sub
        x = "*" & x & "*"
        Dim cell As Range
        Set cell = .Columns(3).Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole)
         
        If cell Is Nothing Then
            MsgBox "Штрих-код не найден", vbCritical
            Exit Sub
        Else
            y1 = cell.Offset(0, 2) - cell.Offset(0, 10)
            y = InputBox(cell.Offset(0, 1) & vbCrLf & "Введите количество товара" & vbCrLf & "Осталось: " & y1 & "шт.", "Количество товара")
            If VarType(y) = vbBoolean Then
                Exit Sub
            Else
                cell.Offset(0, 10) = cell.Offset(0, 10) + CDbl(y)
            End If
            Z = InputBox("Введите цену товара" & vbCrLf & "Закупочная цена: " & Format(cell.Offset(0, 6), "#,##0.00") & " руб." & vbCrLf & "Цена: " & Format(cell.Offset(0, 7), "#,##0.00") & " руб.", "Цена товара")
            If VarType(Z) = vbBoolean Then
                Exit Sub
            Else
                cell.Offset(0, 9) = cell.Offset(0, 9) + CDbl(Z)
                itog = itog + CDbl(Z)
            End If
        End If
        
        Dim xx
        xx = MsgBox("Необходимо найти еще один штрих-код?", vbYesNo, "Поиск штрих-кода")
        If xx = 6 Then
            Кнопка2_Щелчок
        Else
            MsgBox "Общая сумма " & itog & " руб.", vbOKOnly
        End If
        
        If cell.Offset(0, 10) = cell.Offset(0, 2) Then
            With cell.Offset(0, 1): cell.Offset(0, 2).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
        End If
        
    End With
End Sub
Необходимо, чтобы при cell.Offset(0, 10) = cell.Offset(0, 2), ячейки cell.Offset(0, 1) и cell.Offset(0, 2) закрашивались цветом 255 (красный).

И может кто подскажет за одно, почему когда нажимаю на любом этапе отмена или Esc, то выскакивает ошибка, а надо чтобы макрос полностью отменялся.

Всем заранее спасибо.
Макрос: Вывод суммы повторяющихся значений
 
Спасибо большое. Все работает.
Макрос: Вывод суммы повторяющихся значений
 
Всем привет. Спасибо большое за помощь в предыдущей теме. Я свой файл еще немного модернизировал. Код дописал немного. Вот появился очередной вопрос.

Вот код:
Код
Sub Кнопка2_Щелчок()
    With Sheets("Игрушки")
        x = InputBox("Введите штрих-код", "Поиск штрих-кода")
        If VarType(x) = vbBoolean Then Exit Sub
        x = "*" & x & "*"
        Dim cell As Range
        Set cell = .Columns(3).Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole)
         
        If cell Is Nothing Then
            MsgBox "Штрих-код не найден", vbCritical
            Exit Sub
        Else
            y1 = cell.Offset(0, 2) - cell.Offset(0, 10)
            y = InputBox(cell.Offset(0, 1) & vbCrLf & "Введите количество товара" & vbCrLf & "Осталось: " & y1 & "шт.", "Количество товара")
            If VarType(y) = vbBoolean Then
                Exit Sub
            Else
                cell.Offset(0, 10) = cell.Offset(0, 10) + CDbl(y)
            End If
            Z = InputBox("Введите цену товара" & vbCrLf & "Закупочная цена: " & Format(cell.Offset(0, 6), "#,##0.00") & " руб." & vbCrLf & "Цена: " & Format(cell.Offset(0, 7), "#,##0.00") & " руб.", "Цена товара")
            If VarType(Z) = vbBoolean Then
                Exit Sub
            Else
                cell.Offset(0, 9) = cell.Offset(0, 9) + CDbl(Z)
            End If
        End If
        
        Dim xx
        xx = MsgBox("Необходимо найти еще один штрих-код?", vbYesNo, "Поиск штрих-кода")
        If xx = 6 Then: Кнопка2_Щелчок
        If xx = 7 Then: MsgBox "Общая сумма " & Z & " руб.", vbOK
        
    End With
End Sub

Необходимо чтобы в конце выскакивало сообщение с суммарным значением "Z", так как в одном макросе я могу их вводить много раз.

И еще желательно, чтобы в последнем MsgBox не было кнопки "Отмена".

Спасибо заранее.

Макрос: Ввод данных в определенные ячейки строки
 
Спасибо большое. Все ок. А как закрыть тему?
Изменено: Zelen35 - 09.10.2019 21:43:15
Макрос: Ввод данных в определенные ячейки строки
 
Сразу говорю, что я в с макросами уже лет 15 не работал. Очень много забыл.)
Я тут еще кое что добавил в код.
И что-то не могу понять почему на разных этапах, при нажатии на "Отмена", не происходит переход на "Лист1".
Кнопка находится на Листе1.
Изменено: Zelen35 - 08.10.2019 00:28:13
Макрос: Ввод данных в определенные ячейки строки
 
готово)
Макрос: Ввод данных в определенные ячейки строки
 
Всем привет. Извиняюсь за свою первую тему. Но сейчас вроде бы с названием справился.) У меня вопрос. Часть информации, которая нужна мне была для решения своего вопроса из первой темы я уже нашел сам. Но дальше я даже не знаю как правильно сформулировать вопрос в поисковике. Так что повторно вам написал. Может вы поможете. Буду вам благодарен. Короче, к сути вопроса.

Есть следующий макрос.
Код
Sub Кнопка2_Щелчок()
    Sheets("Лист2").Activate
    x = InputBox("Введите код", "Поиск кода")
    If VarType(x) = vbBoolean Then Exit Sub
 
    x_text = "*" & x & "*"
    Dim cell As Range
    Set cell = Cells.Find(What:=x_text, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole)
     
    If cell Is Nothing Then
        MsgBox "Код не найден", vbCritical
    Else
        cell.Activate
    End If
    Sheets("Лист1").Activate
End Sub

Я нахожу по "Коду" нужную мне ячейку, а далее с помощью "InputBox" хочу в определенные ячейки строки в которой находится "Код", вводить данные и причем чтобы введенная цифра суммировалась с уже имеющейся цифрой в ячейке.

Это вообще реально или нет?
Может есть похожие макросы, я бы сам посмотрел?
Или может кто подскажет текст макроса?

В общем, заранее спасибо.
Изменено: Zelen35 - 07.10.2019 23:36:46
[ Закрыто] Помощь в Visual Basic, Помогите с написание макроса
 

Всем привет. Ребята нужна помощь.

Есть файл «111.xlsm», в котором есть «Кнопка 1». При нажатии на эту кнопку уже выскакивает форма с поисковым запросом по «Коду». Вот что надо:

1. Вводим «Код».

2. При нажатии на «ОК» выделяется ячейка в которой есть данный «Код» и при это открывается форма указанная в файле «222.jpg».

3. Затем вводим данные в форме в ячейки «А» и «В».

4. При нажатии на кнопку «ОК» к значениям «А» и «В» в строке с найденным «Кодом» в таблице файла «111.xlsm» прибавляется количество, которое мы ввели в форму из файла «222.jpg». При нажатии на кнопку «Отмена» – форма закрывается.

5. Когда в одной строке значение «В» становится равным значению «Х», то эта строка выделяется красным цветом, как указано в файле «111.xlsm».

6. В случае если значение «В» становится больше значения «Х», должно выскакивать сообщение с надписью «Ошибка ввода данных» и кнопка «ОК», при нажатии на которую форма закрывается.

Заранее большое спасибо за помощь.

Страницы: 1
Наверх