Размер фигуры в excel

Цитата: MickMick от 26.03.2008, 16:29
Можно ли сделать так, чтобы размеры прямоугольника изменялись сразу после ввода числа в ячейку?

Добавь в модуль листа (ПКМ по ярлычку листа -> Исходный текст) следующий код:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.Run "КнигаШпецаДокапыча!UprPryam_SHpetsStyle"
End Sub

Цитата: MickMick от 26.03.2008, 16:29
Возможно ли, чтобы заливкой прямоугольника был или цвет, или рисунок из файла?

Добавь ещё одну строчку, перед строкой Select Case …:

If Range("C2").Value Like "*.jpg" Then s.Fill.UserPicture Range("C2").Value Else s.Fill.Solid
Теперь указав в ячейке C2 полный путь к картинке в виде, например, «C:mylovefas.jpg» (без кавычек, jpg — строчными буквами), получаем требуемый результат.

MickMick, ты правильно решил управлять фигурами

Excel

посредством значений ячеек — это много удобнее, чем подгонять настройки мышкой. Дам тебе пару советов:

Совет №1:
Кроме способов заливки у автофигур есть множество других полезных свойств. Чтобы понять, как их запросто воткнуть в свой код, сделай следующее: включи макрорекордер, поменяй у фигуры какой-нибудь формат, выдели яч.»<любую>«, поменяй формат обратно, жми Alt+F11 и сравни два одинаковых столбика свойств: там, где значение менялось — и будет твоим параметром, которым ты потом можешь оперировать.

Совет №2:
Чтобы увидеть сразу все свойства и параметры свой автофигуры сделаем так:

Sub OkoSHpetsStyle()
   Set SH = ActiveSheet.Shapes("Прямоуг. 1")
End Sub
Не торопись его запускать на выполнение, он у нас для другого:

• вставляем этот код в обычный модуль VBA;
• отображаем окно View -> Locals Window;
• три раза жмём F8 (курсор ввода должен находиться внутри кода);
• в окне Locals появился плюсик рядом с SH, разворачиваем и видим ВСЁ, чем можно управлять с помощью VBA.

Резюмируя вышесказанное, делаем вывод, что, овладев нехитрыми приёмами программного (вместо мышиного) управления форматом автофигур, мы имеем возможность легко вертеть ими как вздумается. Один прямоугольничек, потом два. Человеку всегда хочется большего.

PS: Если для тебя имеет место точность размеров фигур на печати или ради любопытства – измерь линейкой что напечаталось и сравни с указанными размерами в Excel

И на десерт, в приложенном файле, пример на

схеме Аксёнова

. Технология та же: макрoс по моей таблице значений строит вышеназванный бланк, состоящий почти из ПОЛУТЫСЯЧИ автофигур 

Надстройка для Excel, позволяющая добавлять на лист заранее созданные автофигуры, и проставлять для них размеры (с выносными линиями).

На панели инструментов можно выбрать вставляемую фигуру, после чего нарисовать на ней размерные линии

Размеры выделенной фигуры (или её части) вводятся в поля на панели инструментов

При нажатии клавиши Enter к выделенной фигуре добавляется размерная линия (с выносками), возле которой указывается заданный размер (в миллиметрах)

Как автоматически изменить размер формы на основе / в зависимости от указанного значения ячейки в Excel?

Если вы хотите автоматически изменять размер фигуры на основе значения указанной ячейки, эта статья может вам помочь.

Автоматическое изменение размера формы на основе указанного значения ячейки с кодом VBA

Автоматическое изменение размера формы на основе указанного значения ячейки с кодом VBA

Следующий код VBA может помочь вам изменить определенный размер фигуры на основе указанного значения ячейки в текущем листе. Пожалуйста, сделайте следующее.

1. Щелкните правой кнопкой мыши вкладку листа с фигурой, размер которой нужно изменить, а затем щелкните Просмотреть код из контекстного меню.

2. в Microsoft Visual Basic для приложений окна, скопируйте и вставьте следующий код VBA в окно кода.

Код VBA: автоматическое изменение размера формы на основе указанного значения ячейки в Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", Val(Target.Value))
    End If
End Sub
Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Внимание: В коде «Овал 2»- это имя формы, размер которой вы измените. И Ряд = 2, Столбец = 1 означает, что размер формы «Овал 2» будет изменен на значение в A2. Пожалуйста, измените их по своему усмотрению.

Для автоматического изменения размера нескольких фигур на основе разных значений ячеек примените приведенный ниже код VBA.

Код VBA: автоматическое изменение размера нескольких фигур на основе значения разных указанных ячеек в Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xAddress As String
    On Error Resume Next
    If Target.CountLarge = 1 Then
        xAddress = Target.Address(0, 0)
        If xAddress = "A1" Then
            Call SizeCircle("Oval 1", Val(Target.Value))
        ElseIf xAddress = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", Val(Target.Value))
        End If
    End If
End Sub

Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Ноты:

3. Нажмите другой + Q клавиши одновременно, чтобы закрыть Microsoft Visual Basic для приложений окно.

С этого момента, когда вы меняете значение в ячейке A2, размер овала 2 формы будет изменен автоматически. Смотрите скриншот:

Или измените значения в ячейках A1, A2 и A3, чтобы автоматически изменить размеры соответствующих форм «Овал 1», «Смайлик 3» и «Сердце 3». Смотрите скриншот:

Внимание: Размер фигуры больше не будет изменяться, если значение ячейки больше 10.

Статьи по теме:

• Как добавить указатель мыши к определенной форме в Excel?
• Как заполнить фигуру прозрачным цветом фона в Excel?
• Как скрыть или показать определенную фигуру на основе указанного значения ячейки в Excel?