Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.78/9: Рейтинг темы: голосов - 9, средняя оценка - 4.78
Сабрина597
0 / 0 / 0
Регистрация: 10.05.2016
Сообщений: 6
1

Как нарисовать блок-схему в vba

10.05.2016, 11:05. Просмотров 1826. Ответов 13
Метки нет (Все метки)

Как нарисовать несколько квадратов с соединительными линиями в vba?
т.е. квадрат от него линия, еще один квадрат, далее еще линия и так 4 раза
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
10.05.2016, 11:05
Ответы с готовыми решениями:

Составить программу и нарисовать блок схему
Ребята нужно составить программу в Excel с макросами и нарисовать логическую блок схему помогите...

Составить блок-схему алгоритма и программу на VBA
1) Ввести значение переменной n. Ввести значение m. Ввести матрицу A(), в которой n-количество...

Составить блок-схему алгоритма и программу на VBA. Сформировать матрицу
1) Ввести значение переменной n. Ввести значение m. Ввести матрицу А(), в которой n-количество...

Составьте блок-схему и программу на языке VBA для проверки принадлежности точки плоскости
Помогите, пожалуйста, а то задали по информатике, а я ни бу бу в ВБА. задача такая: составьте ...

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

13
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
10.05.2016, 18:00 2
В каком приложении?
0
Сабрина597
0 / 0 / 0
Регистрация: 10.05.2016
Сообщений: 6
10.05.2016, 18:19  [ТС] 3
Excel
0
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
10.05.2016, 18:22 4
А записать макрос религия не позволяет?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Макрос1()
Dim i
    For i = 1 To 4
        ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 100, 40 + i * 50, 100, 30).Select
        Selection.Name = "pr" & i
        If i > 1 Then
            ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 1#, 1#, 2, 2).Select
            Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes("pr" & i - 1), 3
            Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes("pr" & i), 1
            Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
        End If
    Next i
    [a1].Select
End Sub
0
10.05.2016, 18:22
Сабрина597
0 / 0 / 0
Регистрация: 10.05.2016
Сообщений: 6
10.05.2016, 18:30  [ТС] 5
Спасибо, работает, только есть еще один вопрос.
Как сделать чтобы квадратики шли не друг за другом, а по квадрату и последний соединялся с первым?
0
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
10.05.2016, 18:33 6
Поиграйся с координатами
Visual Basic
1
100, 40 + i * 50
Первая Left вторая Top
1
Sasha_Smirnov
5494 / 1322 / 144
Регистрация: 08.02.2009
Сообщений: 4,042
Записей в блоге: 29
10.05.2016, 18:42 7
Отступ слева и отступ сверху соответственно.

Цитата Сообщение от Sasha_Smirnov Посмотреть сообщение
«Папа, а вот сейчас ты с кем разговаривал?..»
0
Сабрина597
0 / 0 / 0
Регистрация: 10.05.2016
Сообщений: 6
10.05.2016, 18:53  [ТС] 8
крутится по-разному, а в нужном порядке не встает
Как нарисовать блок-схему в vba
0
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
10.05.2016, 19:14 9
Лучший ответ Сообщение было отмечено Sasha_Smirnov как решение

Решение

а в нужном порядке не встает
Это приговор..
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Макрос1()
Dim i, k, p, l, t, n, e
k = Split("100,50,300,50,300,200,100,200", ",") 'массив координат
p = Split(",,4,2,3,1,2,4", ",")' массив точек присоединения
    For i = 1 To 4
        l = Val(k(i * 2 - 2))
        t = Val(k(i * 2 - 1))
        n = Val(p(i * 2 - 2))
        e = Val(p(i * 2 - 1))
        ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, l, t, 100, 30).Select
        Selection.Name = "pr" & i
        If i > 1 Then
            ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 1#, 1#, 2, 2).Select
            Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes("pr" & i - 1), n
            Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes("pr" & i), e
            Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
        End If
    Next i
            ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 1#, 1#, 2, 2).Select
            Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes("pr" & i - 1), 1
            Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes("pr1"), 3
            Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
     [a1].Select
End Sub
1
Сабрина597
0 / 0 / 0
Регистрация: 10.05.2016
Сообщений: 6
11.05.2016, 14:36  [ТС] 10
Огромное спасибо))))

Добавлено через 19 часов 20 минут
А как сделать так, чтобы данная программа работала не на листе Excel, а на форме vba?
0
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
11.05.2016, 19:59 11
Это намного заморочней и без АПИ не обойтись!
Лучше начала бы с задачи! (задания)
Что надо-то сделать?
0
Сабрина597
0 / 0 / 0
Регистрация: 10.05.2016
Сообщений: 6
11.05.2016, 21:57  [ТС] 12
чтобы данная задача появлялась на форме при нажатии на нее
т.е. например нажимаешь квадрат, далее нажимаешь от него стрелка и следующий квадрат и так до замыкания
0
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
14.05.2016, 05:49 13
Лучший ответ Сообщение было отмечено Sasha_Smirnov как решение

Решение

код формы Draw.
по клику рисует. Дубльклик стирает
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Option Explicit
Private Type POINTAPI
    x As Double
    Y As Double
End Type
 
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim Coord As New Collection
Dim n_kv
Const maxPoint = 4
 
Private Sub UserForm_Click()
Dim hds, hWnd
Dim pt As POINTAPI, nx, ny, kx, ky, i
 
nx = Split("50,150,50,50,250,350,250,250,50,150,50,50,250,350,250,250,150,300,250,100", ",") 'массив координат x
ny = Split("50,50,90,50,50,50,90,50,190,190,230,190,190,190,230,190,70,90,210,90", ",") 'массив координат
kx = Split("150,150,150,50,350,350,350,250,150,150,150,50,350,350,350,250,250,300,150,100", ",")  'массив координат
ky = Split("50,90,90,90,50,90,90,90,190,230,230,230,190,230,230,230,70,190,210,190", ",") 'массив координат
 
hWnd = FindWindow("thunderDFrame", Draw.Caption)
hds = GetDC(hWnd)
 
    For i = 0 To UBound(nx)
        MoveToEx hds, nx(i), ny(i), pt
        LineTo hds, kx(i), ky(i)
    Next i
    
End Sub
 
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.Hide
    Draw.Show
End Sub
0
Alex77755
10986 / 3443 / 592
Регистрация: 13.02.2009
Сообщений: 10,225
26.05.2016, 21:32 14
По клику по форме рисует по очереди блоки и соединения между ними

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Private Sub UserForm_Click()
Dim hds, hWnd
Dim pt As POINTAPI, nx, ny, kx, ky, i, j
 
nx = Split("50,150,50,50,250,350,250,250,250,350,250,250,50,150,50,50,150,300,250,100", ",") 'массив координат
ny = Split("50,50,90,50,50,50,90,50,190,190,230,190,190,190,230,190,70,90,210,90", ",") 'массив координат
kx = Split("150,150,150,50,350,350,350,250,350,350,350,250,150,150,150,50,250,300,150,100", ",") 'массив координат
ky = Split("50,90,90,90,50,90,90,90,190,230,230,230,190,230,230,230,70,190,210,190", ",") 'массив координат
 
hWnd = FindWindow("thunderDFrame", UserForm1.Caption)
hds = GetDC(hWnd)
 
n_kl = n_kl + 1
 
If n_kl > maxkl Then
    n_kl = 0
    Me.Hide
    UserForm1.Show
Else
    If n_kl = 1 Then
        jj = 16
        For i = 0 To 3
            MoveToEx hds, nx(i), ny(i), pt
            LineTo hds, kx(i), ky(i)
        Next i
    Else
        If n_kl Mod 2 = 0 Then
            j = n_kl * 2
            For i = j To j + 3
                MoveToEx hds, nx(i), ny(i), pt
                LineTo hds, kx(i), ky(i)
            Next i
        Else
            i = jj
            MoveToEx hds, nx(i), ny(i), pt
            LineTo hds, kx(i), ky(i)
            jj = jj + 1
        End If
    End If
End If
End Sub
0
26.05.2016, 21:32
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
26.05.2016, 21:32

Как нарисовать прямоугольник в VBA Excel
Координаты вершин прямоугольника должны задаваться по клику мышки. Я попытался создать программу,...

Как составить структурную(!) блок схему для уравнения: а * sinx + b = c
Здравствуйте. Помогите пожалуйста составить структурную(!) блок схему для уравнения: а * sinx + b =...

Как написать код в VBA (Visual Basic for Applications) по блок-схеме?
Доброго времени суток! Помогите пожалуйста, нужно написать код по блок-схеме в Visual Basic, у меня...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.