Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/изменение параметров растяжения рисунка-фона диаграммы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » изменение параметров растяжения рисунка-фона диаграммы (Макросы/Sub)
изменение параметров растяжения рисунка-фона диаграммы
Rakhot Дата: Понедельник, 17.08.2015, 08:22 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!
Делаю макрос построения треугольной диаграммы. В качестве фона использую рисунок диаграммы Шутова, поверх которой выводятся точки данных.
Для совпадения масштабов рисунка и масштабов осей диаграммы необходимо отрегулировать параметры растяжения рисунка-завливки области построения диаграммы.
Думал, что легко с этим справлюсь при помощи макрорекордера, но но он почему-то записывает только выделение области построения и все...
Облазил весь интернет, нигде решения не нашел, есть только для текстуры... Подскажите, как все-таки программно поменять эти параметры? Дабы не было путаницы, в приложении скрин параметров, какие необходимо поменять.
К сообщению приложен файл: 6896541.jpg (22.2 Kb)
 
Ответить
СообщениеДобрый день!
Делаю макрос построения треугольной диаграммы. В качестве фона использую рисунок диаграммы Шутова, поверх которой выводятся точки данных.
Для совпадения масштабов рисунка и масштабов осей диаграммы необходимо отрегулировать параметры растяжения рисунка-завливки области построения диаграммы.
Думал, что легко с этим справлюсь при помощи макрорекордера, но но он почему-то записывает только выделение области построения и все...
Облазил весь интернет, нигде решения не нашел, есть только для текстуры... Подскажите, как все-таки программно поменять эти параметры? Дабы не было путаницы, в приложении скрин параметров, какие необходимо поменять.

Автор - Rakhot
Дата добавления - 17.08.2015 в 08:22
_Boroda_ Дата: Понедельник, 17.08.2015, 09:43 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация: 6481 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Это нужно?
[vba]
Код
    With ActiveChart.PlotArea.Format.Fill
         .TextureOffsetX = 10
         .TextureOffsetY = 20
     End With
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто нужно?
[vba]
Код
    With ActiveChart.PlotArea.Format.Fill
         .TextureOffsetX = 10
         .TextureOffsetY = 20
     End With
[/vba]

Автор - _Boroda_
Дата добавления - 17.08.2015 в 09:43
Rakhot Дата: Понедельник, 17.08.2015, 10:06 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Нет, это параметры сдвига для текстуры, если их применять, то область построения заполняется картинкой, преобразованной в текстуру... Мне нужны параметры растяжения для рисунка, как в приложенном в 1 посте скрине. Там должно быть по идее 4 параметра - смещение: сверху, снизу, справа, слева.
 
Ответить
Сообщение_Boroda_, Нет, это параметры сдвига для текстуры, если их применять, то область построения заполняется картинкой, преобразованной в текстуру... Мне нужны параметры растяжения для рисунка, как в приложенном в 1 посте скрине. Там должно быть по идее 4 параметра - смещение: сверху, снизу, справа, слева.

Автор - Rakhot
Дата добавления - 17.08.2015 в 10:06
Karataev Дата: Понедельник, 17.08.2015, 13:08 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
Наверное, это тот случай, когда в эксель можно сделать то, что нельзя с помощью VBA.
 
Ответить
СообщениеНаверное, это тот случай, когда в эксель можно сделать то, что нельзя с помощью VBA.

Автор - Karataev
Дата добавления - 17.08.2015 в 13:08
KSV Дата: Понедельник, 17.08.2015, 13:23 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
когда в эксель можно сделать то, что нельзя с помощью VBA

смешно :)

Rakhot, посмотрите, так? [vba]
Код
    With ActiveSheet.Shapes("Диаграмма 1").Fill
            .UserPicture "C:\Pic1.png"  ' здесь пропишите свою картинку
            .TextureAlignment = msoTextureTopLeft
            .TextureOffsetX = 0         ' смещение слева
            .TextureOffsetY = 0         ' смещение сверху
            .TextureHorizontalScale = 1 ' размер картинки по ширине (1 = 100%)
            .TextureVerticalScale = 1   ' размер картинки по высоте (1 = 100%)
            .RotateWithObject = msoTrue ' на случай, если будете вращать диаграмму
        End With
[/vba]

или можно так: [vba]
Код
    With ActiveSheet.Shapes("Диаграмма 1").Fill
           .UserPicture "C:\Pic1.png"  ' здесь пропишите свою картинку
           .TextureAlignment = msoTextureTopLeft
           .TextureOffsetX = 0         ' смещение слева
           .TextureOffsetY = 0         ' смещение сверху
           .TextureTile = msoFalse     ' стиль заполнения: False - растянуть по размеру диаграммы, True - размножить (плитка)
           .RotateWithObject = msoTrue ' на случай, если будете вращать диаграмму
       End With
[/vba]


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333


Сообщение отредактировал KSV - Понедельник, 17.08.2015, 13:55
 
Ответить
Сообщение
когда в эксель можно сделать то, что нельзя с помощью VBA

смешно :)

Rakhot, посмотрите, так? [vba]
Код
    With ActiveSheet.Shapes("Диаграмма 1").Fill
            .UserPicture "C:\Pic1.png"  ' здесь пропишите свою картинку
            .TextureAlignment = msoTextureTopLeft
            .TextureOffsetX = 0         ' смещение слева
            .TextureOffsetY = 0         ' смещение сверху
            .TextureHorizontalScale = 1 ' размер картинки по ширине (1 = 100%)
            .TextureVerticalScale = 1   ' размер картинки по высоте (1 = 100%)
            .RotateWithObject = msoTrue ' на случай, если будете вращать диаграмму
        End With
[/vba]

или можно так: [vba]
Код
    With ActiveSheet.Shapes("Диаграмма 1").Fill
           .UserPicture "C:\Pic1.png"  ' здесь пропишите свою картинку
           .TextureAlignment = msoTextureTopLeft
           .TextureOffsetX = 0         ' смещение слева
           .TextureOffsetY = 0         ' смещение сверху
           .TextureTile = msoFalse     ' стиль заполнения: False - растянуть по размеру диаграммы, True - размножить (плитка)
           .RotateWithObject = msoTrue ' на случай, если будете вращать диаграмму
       End With
[/vba]

Автор - KSV
Дата добавления - 17.08.2015 в 13:23
Rakhot Дата: Понедельник, 17.08.2015, 20:00 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
KSV, честно говоря запутался в коде, т.к. ниразу не программист %) Не могу понять, как адаптировать предложенный вами код к моему. Вы не могли бы посмотреть и сказать, что я не так делаю?
[vba]
Код

Sub chart_test()
Dim oChart As Excel.ChartObject
Set oChart = ActiveSheet.ChartObjects.Add(700, 10, 661, 600)
oChart.Chart.ChartType = xlXYScatter

   
     With oChart.Chart.Axes(xlCategory)
         .MinimumScale = -10
         .MaximumScale = 110
         .Border.Weight = xlHairline
         .Border.LineStyle = xlNone
         .MajorTickMark = xlNone
         .MinorTickMark = xlNone
         .TickLabelPosition = xlNone
     End With

     With oChart.Chart.Axes(xlValue)
         .Border.Weight = xlHairline
         .Border.LineStyle = xlNone
         .MajorTickMark = xlNone
         .MinorTickMark = xlNone
         .TickLabelPosition = xlNone
         .MinimumScale = -10
         .MaximumScale = 100
      
     End With
      
      
      
     Dim Pic As String

  Pic = "c:\Users\Rakhot\Downloads\triangle.jpg"

With oChart.Chart.PlotArea.Fill
     .UserPicture PictureFile:=Pic
     .Visible = True
    ' .TextureTile = msoFalse
     '.TextureAlignment = msoTextureTopLeft
     '.TextureOffsetX = 0         'смещение слева
     '.TextureOffsetY = 0         'смещение сверху
     '.TextureHorizontalScale = 1 ' размер картинки по ширине (1 = 100%)
     '.TextureVerticalScale = 1   ' размер картинки по высоте (1 = 100%)
      
End With

     With oChart.Chart
     .ChartArea.Border.LineStyle = 0
     .PlotArea.Border.LineStyle = 0
     .Legend.Border.LineStyle = 0
     .ChartArea.Format.Fill.Visible = False
     .HasTitle = True
     .ChartTitle.Characters.Text = "Диаграмма Шутова"
      
End With

For Each a In oChart.Chart.Axes
     a.HasMajorGridlines = False
     a.HasMinorGridlines = False
      
Next a

     Dim oSeries As Series
     Set oSeries = oChart.Chart.SeriesCollection.NewSeries
      
     oSeries.Name = "границы"
     oSeries.XValues = "='исходные данные'!$J$7:$J$9"
     oSeries.Values = "='исходные данные'!$K$7:$K$9"
      With oSeries
         .ChartType = xlXYScatter
         .MarkerStyle = xlMarkerStyleCircle
         .MarkerSize = 2
         .MarkerForegroundColor = RGB(255, 0, 0)
         .MarkerBackgroundColor = RGB(255, 0, 0)
          
     End With
     

      

End Sub
[/vba]
Если убрать комментарии, то код выдает ошибку :(
P.S. На всякий случай приложил файлик с проблемным макросом
К сообщению приложен файл: 0386574.xlsm (94.4 Kb)
 
Ответить
СообщениеKSV, честно говоря запутался в коде, т.к. ниразу не программист %) Не могу понять, как адаптировать предложенный вами код к моему. Вы не могли бы посмотреть и сказать, что я не так делаю?
[vba]
Код

Sub chart_test()
Dim oChart As Excel.ChartObject
Set oChart = ActiveSheet.ChartObjects.Add(700, 10, 661, 600)
oChart.Chart.ChartType = xlXYScatter

   
     With oChart.Chart.Axes(xlCategory)
         .MinimumScale = -10
         .MaximumScale = 110
         .Border.Weight = xlHairline
         .Border.LineStyle = xlNone
         .MajorTickMark = xlNone
         .MinorTickMark = xlNone
         .TickLabelPosition = xlNone
     End With

     With oChart.Chart.Axes(xlValue)
         .Border.Weight = xlHairline
         .Border.LineStyle = xlNone
         .MajorTickMark = xlNone
         .MinorTickMark = xlNone
         .TickLabelPosition = xlNone
         .MinimumScale = -10
         .MaximumScale = 100
      
     End With
      
      
      
     Dim Pic As String

  Pic = "c:\Users\Rakhot\Downloads\triangle.jpg"

With oChart.Chart.PlotArea.Fill
     .UserPicture PictureFile:=Pic
     .Visible = True
    ' .TextureTile = msoFalse
     '.TextureAlignment = msoTextureTopLeft
     '.TextureOffsetX = 0         'смещение слева
     '.TextureOffsetY = 0         'смещение сверху
     '.TextureHorizontalScale = 1 ' размер картинки по ширине (1 = 100%)
     '.TextureVerticalScale = 1   ' размер картинки по высоте (1 = 100%)
      
End With

     With oChart.Chart
     .ChartArea.Border.LineStyle = 0
     .PlotArea.Border.LineStyle = 0
     .Legend.Border.LineStyle = 0
     .ChartArea.Format.Fill.Visible = False
     .HasTitle = True
     .ChartTitle.Characters.Text = "Диаграмма Шутова"
      
End With

For Each a In oChart.Chart.Axes
     a.HasMajorGridlines = False
     a.HasMinorGridlines = False
      
Next a

     Dim oSeries As Series
     Set oSeries = oChart.Chart.SeriesCollection.NewSeries
      
     oSeries.Name = "границы"
     oSeries.XValues = "='исходные данные'!$J$7:$J$9"
     oSeries.Values = "='исходные данные'!$K$7:$K$9"
      With oSeries
         .ChartType = xlXYScatter
         .MarkerStyle = xlMarkerStyleCircle
         .MarkerSize = 2
         .MarkerForegroundColor = RGB(255, 0, 0)
         .MarkerBackgroundColor = RGB(255, 0, 0)
          
     End With
     

      

End Sub
[/vba]
Если убрать комментарии, то код выдает ошибку :(
P.S. На всякий случай приложил файлик с проблемным макросом

Автор - Rakhot
Дата добавления - 17.08.2015 в 20:00
KSV Дата: Понедельник, 17.08.2015, 22:49 | Сообщение № 7
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
проверьте
К сообщению приложен файл: 1768162.xlsm (33.2 Kb)


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333
 
Ответить
Сообщениепроверьте

Автор - KSV
Дата добавления - 17.08.2015 в 22:49
Rakhot Дата: Вторник, 18.08.2015, 06:16 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
KSV, Спасибо большое, код запускается, параметры смещения и растяжения редактируются. Но почему-то несмотря на строку
[vba]
Код

.TextureTile = msoFalse
[/vba]
происходит размножение картинки, т.е. преобразование ее в плитку.
Поигравшись параметрами, можно добиться, чтобы в область построения входила только сама картинка, но уже интересно, как сделать все "правильно" :) Чтобы была именно картинка, а не текстура. Кстати при преобразовании в текстуру векторный формат wmf видимо преобразуется экселем в растровый - качество заметно падает...
Получается замкнутый круг - либо текстура с настраиваемыми параметрами смещение/растяжение, либо картинка без настроек, но лучшего качества %)


Сообщение отредактировал Rakhot - Вторник, 18.08.2015, 06:18
 
Ответить
СообщениеKSV, Спасибо большое, код запускается, параметры смещения и растяжения редактируются. Но почему-то несмотря на строку
[vba]
Код

.TextureTile = msoFalse
[/vba]
происходит размножение картинки, т.е. преобразование ее в плитку.
Поигравшись параметрами, можно добиться, чтобы в область построения входила только сама картинка, но уже интересно, как сделать все "правильно" :) Чтобы была именно картинка, а не текстура. Кстати при преобразовании в текстуру векторный формат wmf видимо преобразуется экселем в растровый - качество заметно падает...
Получается замкнутый круг - либо текстура с настраиваемыми параметрами смещение/растяжение, либо картинка без настроек, но лучшего качества %)

Автор - Rakhot
Дата добавления - 18.08.2015 в 06:16
Мир MS Excel » Вопросы и решения » Вопросы по VBA » изменение параметров растяжения рисунка-фона диаграммы (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!