Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
как проставить перечеркнутую Z после последней записи
 
#1
14.07.2024 20:05:21
Добрый вечер.Прошу помочь в решении задачи.Есть таблица, в ней может быть разное количество заполненных ячеек. Необходимо проставить перечеркнутую Z  после последней записи.Рисовать вручную не очень хочется.Может есть другой способ сделать .Пример как должно быть в файле.
 
 
 
#2
14.07.2024 20:57:41
Цитата
GGR написал:
Рисовать вручную не очень хочется. Может есть другой способ сделать .
росчерк используется при печатной форме и заполнении от руки, чтоб никто не приписал лишнего. В полностью печатном варианте, конечно можно впечатать повторно ради подделки, но мало вероятно попадание . Следовательно вопрос, зачем эти потуги?
Ну а автоматизировать можно конечно, рисую линии, но проще заштриховать условным форматированием пустые строки.
По вопросам из тем форума, личку не читаю.
 
 
 
#3
14.07.2024 20:57:52
Есть способ макросом двигать.
Вот набросок - при условии что нижняя строка на месте, только добавляются записи:
Код
Sub tt()

Set lcell = [b29].End(xlDown).Offset(1, 0)
Set sc = ActiveSheet.Shapes.Range(Array("Straight Connector 2"))
sc.Top = lcell.Top + 10
Set sc = ActiveSheet.Shapes.Range(Array("Straight Connector 4"))
sc.Height = [b44].Top - lcell.Top
sc.Top = lcell.Top + 10

End Sub

Т.е. двигаю только верхнюю и косую.
Но можно конечно дорабатывать под задачу.
Изменено: Hugo - 14.07.2024 21:07:03
 
 
 
#4
14.07.2024 23:40:37
Цитата
GGR написал:
Необходимо проставить перечеркнутую Z  после последней записи
а как насчет границы по диагонали в пустых ячейках? ;)
 
 
 
#5
15.07.2024 05:54:29
Всем спасибо за интересные идеи.
Hugo, воспользовалась вашим макросом, но к сожалению у меня выходит запись. В файле скрин. Может я неверно макрос поставила. Не сильна в них. Документов очень много и все разные формы. Бухгалтерия без "Z "сейчас не принимает. Что по строкам, думаю можно конечно сделать конечную строку, чтобы у всех она была одинаковая.
 
 
 
#6
15.07.2024 14:12:02
Код
Sub Макрос1()
    Dim r1 As Range
    Dim r2 As Range
    Dim r3 As Range
    Dim r4 As Range
    Set r1 = Range("B29").End(xlDown).Cells(2, 1)
    Set r2 = r1.Cells(3, 14)
    Set r3 = r1.End(xlDown).Cells(-1, 1)
    Set r4 = Intersect(r2.EntireColumn, r3.EntireRow).Cells(2, 1)
    
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, r1.Left + r1.Width / 2, r1.Top + r1.Height / 2)
        .AddNodes msoSegmentCurve, msoEditingAuto, r2.Left + r2.Width / 2, r2.Top + r2.Height / 2
        .AddNodes msoSegmentCurve, msoEditingAuto, r3.Left + r3.Width / 2, r3.Top + r3.Height / 2
        .AddNodes msoSegmentCurve, msoEditingAuto, r4.Left + r4.Width / 2, r4.Top + r4.Height / 2
        .ConvertToShape.Select
    End With
    Selection.ShapeRange.ShapeStyle = msoLineStylePreset9
End Sub
 
 
 
#7
15.07.2024 14:19:29
Цитата
GGR написал:
Может я неверно макрос поставила.
- правильно, но я писал для файла в котором уже есть эти линии на листе, ну так обычно делают что в заготовленной форме уже всё есть ))
Я такой формой когда-то пользовался - шапки и подписи уже есть, линии тоже внизу расположены - только забиваешь данные и двигаешь линии под последнюю строку - вот код их и двигает. И именно эти которые уже в файле, у других новых вряд ли будут эти же имена.
Изменено: Hugo - 15.07.2024 14:38:54
 
 
 
#8
16.07.2024 19:18:30
МатросНаЗебре, спасибо большое. То что нужно. А можно еще к макросу добавить условие, чтобы можно было убрать эту Z? Результат получится как скрыть- раскрыть.
Изменено: GGR - 16.07.2024 19:53:14
 
 
 
#9
17.07.2024 10:52:42
Код
Sub Макрос1()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.AutoShapeType = 138 Then
            sh.Delete
            Exit Sub
        End If
    Next

    Dim r1 As Range
    Dim r2 As Range
    Dim r3 As Range
    Dim r4 As Range
    Set r1 = Range("B29").End(xlDown).Cells(2, 1)
    Set r2 = r1.Cells(3, 14)
    Set r3 = r1.End(xlDown).Cells(-1, 1)
    Set r4 = Intersect(r2.EntireColumn, r3.EntireRow).Cells(2, 1)
    
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, r1.Left + r1.Width / 2, r1.Top + r1.Height / 2)
        .AddNodes msoSegmentCurve, msoEditingAuto, r2.Left + r2.Width / 2, r2.Top + r2.Height / 2
        .AddNodes msoSegmentCurve, msoEditingAuto, r3.Left + r3.Width / 2, r3.Top + r3.Height / 2
        .AddNodes msoSegmentCurve, msoEditingAuto, r4.Left + r4.Width / 2, r4.Top + r4.Height / 2
        .ConvertToShape.Select
    End With
    Selection.ShapeRange.ShapeStyle = msoLineStylePreset9
End Sub
 
 
 
#10
17.07.2024 18:51:20
МатросНаЗебре , спасибо огромное. Применила на другие формы.
 
 
 
Страницы: 1
Читают тему
Наверх