Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Программирование, связанное с MS Office > Макрос - нестандартный график

Автор: zhenya2010 16.4.2010, 11:06

Привет, люди.

Столкнулся с неполной стандартных графиков Excel.((.
Мне нужно нарисовать довольно примитивные графики(почти гистограммы), смысл в том что гистограмма = это столбики одинаковой ширины и меняющейся высоты, а мне нужно так что бы можно было изменять и высоту и ширину столбцов! :!: .Перерыл кучу софта , что-то похожее нашел только в Delta Graph, но и то не донца. Кто-то мне подсказал что даную задачу можно решить макросом. Сейчас учу VBA, но мне кажется что пока что медленно...Может у когото есть какието соображения по этому поводу? или макрос? или софт?
Хотя решил писать макрос, подскажите как)))? точнее натолкните на мысли...начало..или хоть как то ПОМОГИТЕ,плз

Добавлено через 14 минут и 47 секунд
вот пример.как надо.вверху табличка вводных даных. а ниже график, нарисованый "от руки"...а нужно чтобы макрос рисовал...

Автор: RockClimber 16.4.2010, 11:56

Excel так не умеет, и макросы вряд ли помогут.
В принципе, Excel умеет настраивать ширину столбца гистограммы, но тогда вам на каждое значение создавать отдельный ряд данных. Тогда каждый столбец будет иметь свою ширину (но примыкать друг к другу они не будут).
Есть еще пузырьковая диаграмма - там координаты центра пузырька задаются двумя числами, а третье число задает размер пузырька.

Автор: zhenya2010 16.4.2010, 13:46

Идея построения через макрос - в том что, я думаю(хз может ошибаюсь я не силен в VBA), что бы столбцы представить в виде закрашенных ячеек, хотя конечно потом начнуться проблемы с масштабом. но это уже совсем другая история....)

Автор: zhenya2010 16.4.2010, 14:03

Цитата

В принципе, Excel умеет настраивать ширину столбца гистограммы, но тогда вам на каждое значение создавать отдельный ряд данных. Тогда каждый столбец будет иметь свою ширину (но примыкать друг к другу они не будут).

''''ээээ..как?

Автор: LOPUH 16.4.2010, 14:41

Цитата(zhenya2010 @ 16.4.2010, 18:46)

Это вполне реализуемо и достаточно легко. Вот только будет ли наглядно.. А вы такую вещь как Visio не смотрели?

Автор: zhenya2010 16.4.2010, 15:36

вот клацаю Висио..но чтото мне кажется. что он строит стационарные обьекты...а моя задача "автоматически" строить график в зависимости от значей...

Автор: CaptainNemo 18.4.2010, 23:05

Цитата(zhenya2010 @ 16.4.2010, 15:36)

Воспользуйтесь макрорекодером MS Visio, тогда всё получится. Вот код, который строит нужный Вам график (запускается из Excel, еще необходимо установить ссылку на библиотеку Microsoft Visio Type Library)

Код


Option Base 1
Sub Visio_Graph()
Dim igrok() As String
Dim obV() As Single, RUR() As Single, imax As Integer
i = 2
Do While Not IsEmpty(Worksheets("Лист1").Cells(i, 1))
  i = i + 1
Loop
  imax = i - 1
ReDim igrok(imax): ReDim obV(imax): ReDim RUR(imax)
For i = 1 To imax - 1
  igrok(i) = Worksheets("Лист1").Cells(i + 1, 1).Value
  obV(i) = Worksheets("Лист1").Cells(i + 1, 2).Value / 100
  RUR(i) = Worksheets("Лист1").Cells(i + 1, 3).Value / 10
  Debug.Print igrok(i)
Next

Dim appVisio As Visio.Application
Dim docsObj As Visio.Documents
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim stnObj As Visio.Document
Dim docObj As Visio.Document

 Set appVisio = CreateObject("visio.application")
 Set docsObj = appVisio.Documents
 Set docObj = docsObj.Add("Basic Network.vst")
 Set pagsObj = appVisio.ActiveDocument.Pages
 Set pagObj = pagsObj(1)

x1 = 1: y1 = 1: x2 = 1: y2 = 1: mySum = 2

For i = 1 To imax - 1
    x2 = x2 + obV(i)
    y2 = 1 + RUR(i)
    Set MyObj = pagObj.DrawRectangle(x1, y1, x2, y2)
               x1 = x1 + obV(i)


    Set nadp = pagObj.Shapes.ItemFromID(i).Characters
        nadp.Text = igrok(i) & Chr(13) & obV(i) * 100 & " шт"
    Set cellObj = MyObj.Cells("FillForegnd")
        cellObj.Formula = i + 1
mySum = mySum + obV(i)
Next i
'
With pagObj
    .DrawLine 1, 1, 1, 4
    .DrawLine 1, 1, mySum, 1
Dim textX As Visio.Shape
Set textX = .DrawRectangle(mySum, 0.6, mySum + 0.5, 0.9)
    textX.TextStyle = "Normal"
    textX.LineStyle = "Text Only"
    textX.Text = "V,шт"
Dim textY As Visio.Shape
Set textY = .DrawRectangle(0.5, 4, 1, 4.1)
    textY.TextStyle = "Normal"
    textY.LineStyle = "Text Only"
    textY.Text = "RUR"
End With
End Sub

В итоге в MS Visio должно получиться примерно так:

user posted image

См. приложенный файл.

Автор: zhenya2010 19.4.2010, 10:20

Большое спасибо!

До помогите идиоту)..я включаю Excel ... перехожу в VBA...загружаю библиотеку Microsoft Visio Type Library ( ставлю галочки напротив ) .....и макрос все равно не работает(((...="Can't find project or library"...хотя я же загружал библиотеки....

Буду пытаться сам разбираться, но если что отпишите плз..

Автор: dorogoyIV 19.4.2010, 11:18

Цитата(zhenya2010 @ 19.4.2010, 10:20

)

ставлю галочки напротив

этого мало. надо установить MS Visio

Автор: zhenya2010 19.4.2010, 11:23

Цитата

этого мало. надо установить MS Visio

)). да нет.визио у меня есть..правда я вот переустанавливаю его.может это изза того что у меня была Триал версия. Сейчас посмотрим что будет с полной, так как работа макроса дошла до строки

Set docObj = docsObj.Add("Basic Network.vst")

вот я и думаю что наверное ииза триал версии...хз

Автор: CaptainNemo 19.4.2010, 11:49

У вас нет шаблона Basic Network.vst, попробуйте заменить, например, на Basic Diagram.vst

Код


Set docObj = docsObj.Add("Basic Diagram.vst")

Автор: zhenya2010 19.4.2010, 17:00

CaptainNemo
Вам огромное спасибо.....

А предыдущую проблему я все таки устранил установкой полной версии Визио...работает! smile