Delete diagram from sheet

[FryGirl]

Two questions.

1) I have some code that will create a Vertical Org Chart, but when I'm ready to run the code again for a new Org Chart, how do I delete the Diagram.

I recorded the action to delete the diagram, but the number may not be the same every time.

Sub Macro1()
    ActiveSheet.Shapes.Range(Array("Diagram 1")).Delete
End Sub

2) How can I align the diagram starting in D11 and resized to a bigger size?

 

[lrobbo314]

1. As long as you don't have other objects that you need on the sheet, you can clear out all of the shapes with this line.

Activesheet.DrawingObjects.Delete

2. What does the code look like that is generating the diagram?

 

[FryGirl]

I do actually have a Form button on the sheet also that this is deleting.

The code, it's not my code, just something I found on the web. The code is somewhat lengthy.

Option Explicit
Dim ExcConn, AccConn As ADODB.Connection
Dim RecSt1, RecSt2, RecSt3, RecSt4, RecSt5, RecSt6 As ADODB.Recordset
Dim RecSt7, RecSt8, RecSt9, RecSt10, RecSt11 As ADODB.Recordset
Dim ExWSheet1, ExWSheet2 As Excel.Worksheet
Dim ExRange1 As Excel.Range
Dim sSQL, FilePath, StrDBPath, ConStr As String
Dim oShp As Variant
Dim xlRow, xlCol, i, CurManLevel, Line, Count1, Count2, Count3 As Integer
Dim oSALayout As SmartArtLayout
Dim PQNode, CQNode, ParNode2, CQNode2, ParNode3, CQNode3, CQNode4, ParNode4 As SmartArtNode
Dim QNodes As SmartArtNodes
Dim ParID, Par2Id, Par3Id, Par4Id As String
Dim Found As Boolean
Dim ParNode, CQNode5, ParNode5, CQNode6, ParNode6, CQNode7, ParNode7, CQNode8, ParNode8 As SmartArtNode
Dim CQNode9, ParNode9, CQNode10, ParNode10 As SmartArtNode
Dim CurPid, Par5Id, Par6Id, Par7Id, Par8Id, Par9Id, Par10Id As String
Dim ChartTypeNum As Integer
Sub CmdChart()
xlRow = 4
xlCol = 2
Set ExWSheet2 = Sheets("Chartsheet")
Set ExWSheet1 = Sheets("ControlSheet")
' Source.Rows(Line).Delete 'To delete a line in Excel
Call ExConn
If ExWSheet2.Cells(xlRow, xlCol) = "Vertical Org Chart" Then
ChartTypeNum = 97
ElseIf ExWSheet2.Cells(xlRow, xlCol) = "Name & Title Org Chart" Then
ChartTypeNum = 99
ElseIf ExWSheet2.Cells(xlRow, xlCol) = "Half Circle Org Chart" Then
ChartTypeNum = 100
ElseIf ExWSheet2.Cells(xlRow, xlCol) = "Horizontal Org Chart" Then
ChartTypeNum = 104
Else
ChartTypeNum = 97

End If
' Chart Building Start
If ExWSheet1.Cells(1500, 3) = "checked" Then
Set RecSt3 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where (MemberName is not null and (MemberName=ReportTo));"
RecSt3.Open sSQL, ExcConn, adOpenKeyset
If RecSt3.EOF = False Then
Set oSALayout = Application.SmartArtLayouts(ChartTypeNum)
Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)

Set QNodes = oShp.SmartArt.AllNodes
For i = 1 To 5
oShp.SmartArt.AllNodes(1).Delete
Next

RecSt3.MoveFirst
Count1 = 0
Count2 = 0
Count3 = 0
Do While Not RecSt3.EOF
Set PQNode = oShp.SmartArt.AllNodes.Add
PQNode.TextFrame2.TextRange.Text = RecSt3("ReportTo")
ParID = RecSt3("ReportTo")
' Child
Set RecSt4 = New ADODB.Recordset ' For level down Hirarchy
sSQL = "SELECT * from [A10:B100] where ReportTo like '" & ParID & "' and MemberName not like ReportTo ;"
RecSt4.Open sSQL, ExcConn, adOpenKeyset
If RecSt4.EOF = False Then
RecSt4.MoveFirst
Do While Not RecSt4.EOF
Par2Id = RecSt4("MemberName")
Set ParNode = PQNode
Set CQNode = ParNode.AddNode(msoSmartArtNodeBelow)
CQNode.TextFrame2.TextRange.Text = RecSt4("MemberName")
' Level 3
Set RecSt2 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par2Id & "'"
RecSt2.Open sSQL, ExcConn, adOpenKeyset
If RecSt2.EOF = False Then
RecSt2.MoveFirst
Do While Not RecSt2.EOF
Set ParNode2 = CQNode
Set CQNode2 = ParNode2.AddNode(msoSmartArtNodeBelow)
CQNode2.TextFrame2.TextRange.Text = RecSt2("MemberName")
Par3Id = RecSt2("MemberName")
' Level 4
Set RecSt5 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par3Id & "'"
RecSt5.Open sSQL, ExcConn, adOpenKeyset
If RecSt5.EOF = False Then
RecSt5.MoveFirst
Do While Not RecSt5.EOF
Set ParNode3 = CQNode2
Set CQNode3 = ParNode3.AddNode(msoSmartArtNodeBelow)
CQNode3.TextFrame2.TextRange.Text = RecSt5("MemberName")
Par4Id = RecSt5("MemberName")
' Level 5
Set RecSt1 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par4Id & "'"
RecSt1.Open sSQL, ExcConn, adOpenKeyset
If RecSt1.EOF = False Then
RecSt1.MoveFirst
Do While Not RecSt1.EOF
Set ParNode4 = CQNode3
Set CQNode4 = ParNode4.AddNode(msoSmartArtNodeBelow)
CQNode4.TextFrame2.TextRange.Text = RecSt1("MemberName")
Par5Id = RecSt1("MemberName")
' Level 6
Set RecSt6 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par5Id & "'"
RecSt6.Open sSQL, ExcConn, adOpenKeyset
If RecSt6.EOF = False Then
RecSt6.MoveFirst
Do While Not RecSt6.EOF
Set ParNode5 = CQNode4
Set CQNode5 = ParNode5.AddNode(msoSmartArtNodeBelow)
CQNode5.TextFrame2.TextRange.Text = RecSt6("MemberName")
Par6Id = RecSt6("MemberName")
' Level 7
Set RecSt7 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par6Id & "'"
RecSt7.Open sSQL, ExcConn, adOpenKeyset
If RecSt7.EOF = False Then
RecSt7.MoveFirst
Do While Not RecSt7.EOF
Set ParNode6 = CQNode5
Set CQNode6 = ParNode6.AddNode(msoSmartArtNodeBelow)
CQNode6.TextFrame2.TextRange.Text = RecSt7("MemberName")
Par7Id = RecSt7("MemberName")
' Level 8
Set RecSt8 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par7Id & "'"
RecSt8.Open sSQL, ExcConn, adOpenKeyset
If RecSt8.EOF = False Then
RecSt8.MoveFirst
Do While Not RecSt8.EOF
Set ParNode7 = CQNode6
Set CQNode7 = ParNode7.AddNode(msoSmartArtNodeBelow)
CQNode7.TextFrame2.TextRange.Text = RecSt8("MemberName")
Par8Id = RecSt8("MemberName")
' Level 9
Set RecSt9 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par8Id & "'"
RecSt9.Open sSQL, ExcConn, adOpenKeyset
If RecSt9.EOF = False Then
RecSt9.MoveFirst
Do While Not RecSt9.EOF
Set ParNode8 = CQNode7
Set CQNode8 = ParNode8.AddNode(msoSmartArtNodeBelow)
CQNode8.TextFrame2.TextRange.Text = RecSt9("MemberName")
Par9Id = RecSt9("MemberName")
' Level 10
Set RecSt10 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par9Id & "'"
RecSt10.Open sSQL, ExcConn, adOpenKeyset
If RecSt10.EOF = False Then
RecSt10.MoveFirst
Do While Not RecSt10.EOF
Set ParNode9 = CQNode8
Set CQNode9 = ParNode9.AddNode(msoSmartArtNodeBelow)
CQNode9.TextFrame2.TextRange.Text = RecSt10("MemberName")
Par10Id = RecSt10("MemberName")
' Level 11
Set RecSt11 = New ADODB.Recordset
sSQL = "SELECT * FROM [A10:B100] where ReportTo like '" & Par10Id & "'"
RecSt11.Open sSQL, ExcConn, adOpenKeyset
If RecSt11.EOF = False Then
RecSt11.MoveFirst
Do While Not RecSt11.EOF
Set ParNode10 = CQNode9
Set CQNode10 = ParNode10.AddNode(msoSmartArtNodeBelow)
CQNode10.TextFrame2.TextRange.Text = RecSt11("MemberName")
Par10Id = RecSt11("MemberName")

RecSt11.MoveNext
Loop
End If
Par10Id = ""
' Level 11 end
RecSt10.MoveNext
Loop
End If
Par9Id = ""
' Level 10 end
RecSt9.MoveNext
Loop
End If
Par8Id = ""
' Level 9 end
RecSt8.MoveNext
Loop
End If
Par7Id = ""
' Level 8 end
RecSt7.MoveNext
Loop
End If
Par6Id = ""
' Level 7 end
RecSt6.MoveNext
Loop
End If
Par5Id = ""
' Level 6 end
RecSt1.MoveNext
Count2 = Count2 + 1
Loop
End If
RecSt5.MoveNext
Par4Id = ""
' Level 5 end
Count2 = Count2 + 1
Loop
End If
Par3Id = ""
' Level 4 end
RecSt2.MoveNext
Count2 = Count2 + 1
Loop
End If
Par2Id = ""
' Level 3 end
Count1 = Count1 + 1
Count2 = Count2 + 1
RecSt4.MoveNext
Loop
End If
' Child end
RecSt3.MoveNext
Loop
End If
Else
' Chart building End
Call ObjClosing
End If
End Sub

Sub ExConn()
FilePath = ""
FilePath = Application.ActiveWorkbook.FullName
Set ExcConn = New ADODB.Connection
ConStr = "Provider=Microsoft.ACE.OLEDB.16.0;" & "Data Source= " & FilePath & ";" & "Extended Properties=""Excel 8.0;HDR=Yes"";"
ExcConn.Open (ConStr)
End Sub

Sub ObjClosing()
Set RecSt1 = Nothing
Set RecSt2 = Nothing
Set RecSt3 = Nothing
Set RecSt4 = Nothing
Set RecSt5 = Nothing
Set RecSt6 = Nothing
Set RecSt7 = Nothing
Set RecSt8 = Nothing
Set RecSt9 = Nothing
Set RecSt10 = Nothing
Set ExWSheet2 = Nothing
Set ExWSheet1 = Nothing
Set ExRange1 = Nothing
ExcConn.Close
Set ExcConn = Nothing
End Sub

 

[FryGirl]

Here is the info table.

Book1
	A	B
10	MemberName	ReportTo
11	CEO	CEO
12	CFO	CEO
13	CTO	CEO
14	CMO	CEO
15	Finance Director	CFO
16	Finance Manager	CFO
17	Legal Adviser	CFO
18	Marketing Director	CMO
19	Sales Director	CMO
20	Advertising and Design	CMO
21	IT Manager	CTO
22	IT Director	CTO
23	Tax Consultant	Finance Director
24	Finance	Finance Director
25	Chief of Staff	CEO
26	Company Politics	CEO
ChartSheet

 

[lrobbo314]

I thought there were a bunch of objects on the sheet. Does this it.

ActiveSheet.DrawingObjects("Diagram 1").Delete

 

[lrobbo314]

Then this snippet shows how you would manipulate the position and size of the diagram.

Sub test()
Set oSALayout = Application.SmartArtLayouts(104)
Set oshp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)

With oshp
    .Width = 600
    .Height = 600
    .Left = Range("D1").Left
    .Top = Range("D1").Top
End With
End Sub

 

[FryGirl]

That would do it maybe the first time thru, but if the user produces a second diagram in the same Excel session, then the Diagram would be 2 and so on.

 

[lrobbo314]

That would do it maybe the first time thru, but if the user produces a second diagram in the same Excel session, then the Diagram would be 2 and so on.

Just name the diagram manually and you won't need to account for the incrementing numbers.

Sub test()
On Error GoTo ERH
Set oSALayout = Application.SmartArtLayouts(104)
Set oshp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)

ActiveSheet.DrawingObjects("MyDiagram").Delete

ERH:
If Err.Number = 1004 Or Err.Number = 0 Then
    With oshp
        .Name = "MyDiagram"
        .Width = 600
        .Height = 600
        .Left = Range("D1").Left
        .Top = Range("D1").Top
    End With
Else
    MsgBox "Error #" & Err.Number & vbLf & Err.Description
End If

 

[FryGirl]

Sub test()
    Set oSALayout = Application.SmartArtLayouts(104)
    Set oShp = ActiveWorkbook.ActiveSheet.DrawingObjects("Diagram 20")
    With oShp
        .Width = 600
        .Height = 600
        .Left = Range("D1").Left
        .Top = Range("D1").Top
    End With
End Sub

Next question, how do I have the current diagram on the sheet select and then pass it as a variable into the sub above?

 

[FryGirl]

Just name the diagram manually and you won't need to account for the incrementing numbers.

How will the user be able to do this every time? What if they create 10 - 15 charts all in one session?