Доброе утро. Есть макрос, ставящий единицы под центрами картинок-Кружков и удаляющий прочие единицы в диапазоне.
Подскажите, пожалуйста, как ставить под картинками не единицы, а те числа, которые приведены в диапазоне AV4:AW7 ? (А под теми картинками, которых нет в диапазоне AV4:AW7 - ничего не должно ставится )
Доброе утро. Есть макрос, ставящий единицы под центрами картинок-Кружков и удаляющий прочие единицы в диапазоне.
Подскажите, пожалуйста, как ставить под картинками не единицы, а те числа, которые приведены в диапазоне AV4:AW7 ? (А под теми картинками, которых нет в диапазоне AV4:AW7 - ничего не должно ставится )OlegSmirnov
Dim shp As Shape Dim lr As Long, i As Long, c As Integer, r As Long
Application.ScreenUpdating = False Range("A1").Select Range("F3:AR38").ClearContents lr = Cells(Rows.Count, "AV").End(xlUp).Row For i = 4 To lr Set shp = ActiveSheet.Shapes(Cells(i, "AV").Value) r = (shp.BottomRightCell.Row - shp.TopLeftCell.Row) / 2 c = (shp.BottomRightCell.Column - shp.TopLeftCell.Column) / 2 shp.TopLeftCell.Offset(r, c) = Cells(i, "AW").Value Next i Application.ScreenUpdating = True
End Sub
[/vba]
[vba]
Код
Sub Проставить_числа_у_фигур()
Dim shp As Shape Dim lr As Long, i As Long, c As Integer, r As Long
Application.ScreenUpdating = False Range("A1").Select Range("F3:AR38").ClearContents lr = Cells(Rows.Count, "AV").End(xlUp).Row For i = 4 To lr Set shp = ActiveSheet.Shapes(Cells(i, "AV").Value) r = (shp.BottomRightCell.Row - shp.TopLeftCell.Row) / 2 c = (shp.BottomRightCell.Column - shp.TopLeftCell.Column) / 2 shp.TopLeftCell.Offset(r, c) = Cells(i, "AW").Value Next i Application.ScreenUpdating = True