Страницы: 1
RSS
Макрос: Заливка ячеек при определенных параметрах
 
Всем привет. Спасибо всем за помощь на предыдущих этапах. Появился новый вопрос. Попытался сам записать макрос и добавить в свой, но ничего не получилось.

Вот код:
Код
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, то выскакивает ошибка, а надо чтобы макрос полностью отменялся.

Всем заранее спасибо.
 
Я так понял, никто не поможет)
 
довольно очевидно - наивно ждать ответ на не сформулирован вопрос
другими словами: нет вопроса  - нет ответа
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Код
 With Union(cell.Offset(0, 1), cell.Offset(0, 2)).Interior
 
Название темы общее, не видно Вашей задачи. Предложите. Модерторы заменят
 
Цитата
Zelen35 написал:
Я так понял, никто не поможет)
Вы абсолютно правильно все поняли
сформулируете вопрос  - возможно получите ответ, а пока нет вопроса не ждите ответа, его не будет!!!
не можете сформулировать вопрос - решайте пока свою задачу самостоятельно
удачи!
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
RAN, спасибо большое. Все работает.
Страницы: 1
Наверх