Excel drawing functionality to create project plot plan and process flow diagram.
This page introduces an Excel VBA application to create an Excel drawing.
The drawing functionality built in the Excel are utilized to help draw project drawings such as plot plan, PFD, PID and so on.
1. Download program and picture files
Download the .xlsm file and a collection of pictures. Download a Zip file.
2. User Interface
You can create your preferred method to run the program referring to the page
User Interface 6 methods
The program in the file you can download adds an Icon on the Quick Access Tool bar (Method 4).
Refer to the video clip below.
3.Start the program
Click the Icon on the Quick Access Tool bar made according to the section 2 above. This allows two new worksheets to be generated for the first program run and activate the Userform designed for creating an Excel drawing.
- Excel Dwg consisting of square cells representing 10 x 10 m each.
- Dwg Data
4.Create an Excel drawing
- Select a cell where left top of a new shape is positioned.
- Choose the type of component to be drawn on the userform.
- Define the tag and description of the component
- Refine exact coordinate, dimension, and rotation of the components on the userform
- OK button is enabled and press the OK button.
- The component is drawn as defined and the details of the component are listed on the worksheet Dwg Data.
- Repeat step 1 to step 6.
5. Display details of the existing component.
Press the component of interest on the worksheet Excel Dwg to enable details to be repainted on the Userform.
The selected component event is triggered by using Shape.OnAction property.
This property sets the name of a macro ("ExcelDwg_OnAction") that is run when the specified object is chosen.
sh.OnAction = "ExcelDwg_OnAction"
'************************************************************
'Activate/Deactivate existing shapes
'************************************************************
Sub ExcelDwg_Activate()
Dim sh As Shape
On Error Resume Next
Set ws = ActiveWorkbook.Worksheets("Excel Dwg")
If Err = 0 Then
ws.Activate
For Each sh In ws.Shapes
If sh.Name Like "*Label*" Then
Else
sh.OnAction = "ExcelDwg_OnAction"
End If
Next sh
End If
On Error GoTo 0
End Sub
Sub ExcelDwg_Deactivate()
Dim sh As Shape
On Error Resume Next
Set ws = ActiveWorkbook.Worksheets("Excel Dwg")
If Err = 0 Then
ws.Activate
For Each sh In ws.Shapes
sh.OnAction = vbNullString
Next sh
End If
On Error GoTo 0
End Sub
'************************************************************
'Shape event procedure
'************************************************************
Sub ExcelDwg_OnAction()
Dim x As Double, y As Double, w As Double, h As Double, tr As Double, rt As Double
Dim sName As String, sDescript As String, sType As String
Dim sh As Shape, frm As Object
Dim shName As String
Dim i As Long, Finalrow As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set ws = ActiveWorkbook.Worksheets("Excel Dwg")
If Err = 0 Then
For Each sh In ws.Shapes
sh.Fill.ForeColor.RGB = RGB(255, 255, 255)
Next
If ws.Shapes(Application.Caller).Name Like "*Label*" Then
Else
With ws.Shapes(Application.Caller)
x = .Left
y = .Top
w = .Width
h = .Height
tr = .Fill.Transparency
rt = .Rotation
sName = Left(.Name, InStr(.Name, "(") - 1)
sDescript = Mid(.Name, InStrRev(.Name, ":") + 1)
sType = Mid(.Name, InStr(.Name, "(") + 1, InStrRev(.Name, ")") - InStr(.Name, "(") - 1)
Set wsd = ActiveWorkbook.Worksheets("Dwg Data")
Finalrow = wsd.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Finalrow
If wsd.Cells(i, 1) = sName Then
sDescript = wsd.Cells(i, 2).Value
Exit For
End If
Next i
.Fill.ForeColor.RGB = RGB(200, 200, 200)
End With
With uf_ExcelDwg
.TextBox11.Value = x
.TextBox12.Value = y
.TextBox13.Value = w
.TextBox14.Value = h
.TextBox1.Value = x / 28.5 + 1
.TextBox2.Value = y / 28.5 + 1
.TextBox3.Value = w / 28.5
.TextBox4.Value = h / 28.5
.TextBox21.Value = x / 28.5 * 10
.TextBox22.Value = y / 28.5 * 10
.TextBox23.Value = w / 28.5 * 10
.TextBox24.Value = h / 28.5 * 10
.TextBox5.Value = tr
.TextBox6.Value = rt
.TextBox7.Text = sName
.TextBox8.Text = sDescript
.Label16.Caption = sType
End With
End If
End If
On Error GoTo 0
Dim PreTop As Double, PreLeft As Double
With uf_ExcelDwg
.StartUpPosition = 0
PreTop = .Top: PreLeft = .Left
.Repaint
.Top = PreTop: .Left = PreLeft
For Each frm In VBA.UserForms
If frm.Name = "uf_ExcelDwg" Then
Else
.Show
Exit For
End If
Next
End With
6. Customizing the program
If you want additional components to be drawn, you need to add the required CommandButtons on the userform and the corresponding images (.gif) are to be placed in the image subfolder of the main folder for the program file exceldwg.xlsm. If you need some support from us, feel free to contact us.
Dated on: 26-December-2019