ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copy structure chart (https://www.excelbanter.com/excel-programming/426290-copy-structure-chart.html)

Martin

Copy structure chart
 
Hello,

I have the following code which i think is close but not close enough. I
want to get the value from a cell in one workbook, look up that value which
will be a tab name in another workbook, find a structure chart in that sheet
and paste it back in to the sheet I started with. This is what I have:

Dim RegionName As String

RegionName = Sheets("Qry_Basic_Information").Range("A2").Value
Windows("My Pack (Structure Charts).xls").Activate
Sheets(RegionName).Select

For Each myshape In ActiveSheet.Shapes
If myshape.Type = 12 Then myshape.Copy
Next myshape

Windows("My Pack.xls").Activate
Range("B6").Select
ActiveSheet.Paste

Can anyone point me in the right direction?

Many thanks in advance,

Martin

joel

Copy structure chart
 
See if this works. When you paste a shape you have to paste it and then move
it to the correct location. Vecause a shape sits ontop of the worksheet you
can't just position the shape to a range location, instead you have to use
the left and top properties like below.


Dim RegionName As String
Set StructChrts = Workbooks("My Pack (Structure Charts).xls")
Set PackBk = Workbooks("My Pack.xls")

With PackBk.Sheets("Qry_Basic_Information")
RegionName = .Range("A2").Value

With StructChrts.Sheets(RegionName)

For Each myshape In .Shapes
If myshape.Type = 12 Then

myshape.Copy
.Paste
Set NewShape = Selection
NewShape.Top = Range("B6").Top
NewShape.Left = Range("B6").Left
End If
Next myshape
End With
End With

"Martin" wrote:

Hello,

I have the following code which i think is close but not close enough. I
want to get the value from a cell in one workbook, look up that value which
will be a tab name in another workbook, find a structure chart in that sheet
and paste it back in to the sheet I started with. This is what I have:

Dim RegionName As String

RegionName = Sheets("Qry_Basic_Information").Range("A2").Value
Windows("My Pack (Structure Charts).xls").Activate
Sheets(RegionName).Select

For Each myshape In ActiveSheet.Shapes
If myshape.Type = 12 Then myshape.Copy
Next myshape

Windows("My Pack.xls").Activate
Range("B6").Select
ActiveSheet.Paste

Can anyone point me in the right direction?

Many thanks in advance,

Martin


Martin

Copy structure chart
 
Joel, thank you, worked a treat!

Martin

"joel" wrote:

See if this works. When you paste a shape you have to paste it and then move
it to the correct location. Vecause a shape sits ontop of the worksheet you
can't just position the shape to a range location, instead you have to use
the left and top properties like below.


Dim RegionName As String
Set StructChrts = Workbooks("My Pack (Structure Charts).xls")
Set PackBk = Workbooks("My Pack.xls")

With PackBk.Sheets("Qry_Basic_Information")
RegionName = .Range("A2").Value

With StructChrts.Sheets(RegionName)

For Each myshape In .Shapes
If myshape.Type = 12 Then

myshape.Copy
.Paste
Set NewShape = Selection
NewShape.Top = Range("B6").Top
NewShape.Left = Range("B6").Left
End If
Next myshape
End With
End With

"Martin" wrote:

Hello,

I have the following code which i think is close but not close enough. I
want to get the value from a cell in one workbook, look up that value which
will be a tab name in another workbook, find a structure chart in that sheet
and paste it back in to the sheet I started with. This is what I have:

Dim RegionName As String

RegionName = Sheets("Qry_Basic_Information").Range("A2").Value
Windows("My Pack (Structure Charts).xls").Activate
Sheets(RegionName).Select

For Each myshape In ActiveSheet.Shapes
If myshape.Type = 12 Then myshape.Copy
Next myshape

Windows("My Pack.xls").Activate
Range("B6").Select
ActiveSheet.Paste

Can anyone point me in the right direction?

Many thanks in advance,

Martin



All times are GMT +1. The time now is 05:26 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com