heysus jamal
06-27-2012, 08:43 AM
Hi all :hi:, been lurking on the boards for a few weeks now but finally decided to register and ask for some help. Keep in mind this is the first macro I have ever written - I put the breaks in the code with headers to help me remember what each function does. (BTW I am using Office 2007)
Basically I am trying to pull numerous tables and charts from various locations into one file. The control tab houses the information that drives the macro. It works by opening the file (based on the info from the control tab) containing the table/chart > copying it (as a picture) > and pasting it (as a picture) in the 'Tables & Charts' tab.
I have tested it numerous times and the macro works how I want it to. However there a three relatively two minor glitches that prevent it from being perfect, IMO....
1) There are several charts that I wish to bring into my file that are which happen to be what I like to call 'entire tabs.' Meaning the actual chart itself takes up the entire tab. I couldn't find a chart # like I did with other charts that did not take up entire tabs, so I solved this by literally grabbing the entire tab and copying it to the end of my file. But by doing this it loses the formatting of the dates, ie: 12/31/2011 turns into the Julian date format. Is there such a code where I can copy just a picture of the tab rather than the entire tab?
2) When I paste the table/chart into the 'tables & charts' tab I made the macro leave 40 spaces in between each image, because some images are larger than others and I don't want overlapping. Is there a code to have the pictures automatically be right below each other when pasting - so that I don't have ~50 pictures spanning ~2000 cells?
Please let me know if I am not being specific enough with what I am trying to do and if you would like me to clarify anything. Any help would be MUCH appreciated! : pray2:
My test file is attached. You can see the code below.
'THIS MACRO OPENS THE VARIOUS FILES USED IN THE BSM REPORT AND COMPILES THE DESIRED PIECES IN ONE LOCATION
Sub updateDocx()
'THIS SECTION HIDES ANY MESSAGES/ALERTS
'************************************************************************** ************
Application.DisplayAlerts = False
'VARIABLE TYPES ARE DEFINED BELOW
'************************************************************************** ************
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim j As Integer
Dim currPath As String
Dim currwb As String
Dim tableChartFlag As String
Dim FileLocation As String
Dim FileName As String
Dim tabName As String
Dim RangeName As String
Dim i As Integer
currPath = ActiveWorkbook.Path
currwb = ActiveWorkbook.Name
'THIS CLEARS THE 'TABLES & CHARTS' TAB
'************************************************************************** ************
Sheets("Tables & Charts").Delete
Sheets.Add.Name = "Tables & Charts"
Sheets("Tables & Charts").Select
'THIS DELETES ANY EXTRA TABS
'************************************************************************** ************
While Sheets.Count > 5
Sheets(Sheets.Count).Delete
Wend
'THIS SPECIFIES THE START ROW FOR THE MACRO
'************************************************************************** ************
i = Sheets("Control").Cells(2, 2)
'THIS SECTION USES THE INFORMATION IN THE CONTROL TAB TO LOCATE THE DESIRED OBJECTS
'************************************************************************** ************
While Not IsEmpty(Sheets("Control").Cells(i, 7))
FileLocation = Sheets("Control").Cells(i, 3).Value
FileName = Sheets("Control").Cells(i, 4).Value
tabName = Sheets("Control").Cells(i, 5).Value
RangeName = Sheets("Control").Cells(i, 6).Value
'THIS LOOP SKIPS ITEMS WHICH ARE NO LONGER INCLUDED IN THE REPORT VIA THE RANGE COLUMN
'************************************************************************** ************
If RangeName = "" Then GoTo aaa
'THIS SPECIFIES IF AN OBJECT IS A TABLE VS. CHART
'************************************************************************** ************
On Error Resume Next
tableChartFlag = WorksheetFunction.Find(":", RangeName, 1)
If Err.Number = 1004 Then
tableChartFlag = "C"
Else: tableChartFlag = "T"
End If
On Error Resume Next
Windows(FileName).Activate
If Err.Number <> 0 Then
Workbooks.Open FileName:=FileLocation & "\" & FileName
If Err.Number = 1004 Then
MsgBox ("On Row " & i & " " & Err.Description)
GoTo bbb
End If
End If
'THIS SECTION COPIES THE DESIRED OBJECT - USING 'COPY AS PICTURE'
'************************************************************************** ************
Sheets(tabName).Select
'FOR TABLE/CHART
If tableChartFlag = "T" Then
Range(RangeName).Select
ElseIf tableChartFlag = "C" Then ActiveSheet.ChartObjects(RangeName).Activate
Else: MsgBox ("Table/Chart Flag missing!!")
End If
'FOR ENTIRE TAB - THIS CREATES AN ADDITIONAL TAB AT THE END OF THE FILE
If RangeName = "ENTIRE TAB" Then
Sheets(tabName).Select
Sheets(tabName).Copy After:=Workbooks(currwb).Sheets(Workbooks(currwb).Sheets.Count)
Else
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End If
'THIS RETURNS TO THE BSM REPORT CREATION FILE AND PASTES THE OBJECT 'AS A PICTURE'
'************************************************************************** ************
Windows(currwb).Activate
Sheets("Tables & Charts").Select
'THIS LEAVES A GAP OF 40 CELLS BETWEEN PASTED OBJECTS
ActiveCell.Offset(0, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(40, 0).Select
'THIS CLOSES THE FILE FROM WHICH AN OBJECT WAS RETRIEVED
'************************************************************************** ************
If FileName <> Sheets("Control").Cells(i + 1, 4).Value Then
Windows(FileName).Activate
ActiveWorkbook.Close
End If
'LOOPS
'************************************************************************** ************
aaa:
i = i + 1
Wend
bbb:
End Sub
Basically I am trying to pull numerous tables and charts from various locations into one file. The control tab houses the information that drives the macro. It works by opening the file (based on the info from the control tab) containing the table/chart > copying it (as a picture) > and pasting it (as a picture) in the 'Tables & Charts' tab.
I have tested it numerous times and the macro works how I want it to. However there a three relatively two minor glitches that prevent it from being perfect, IMO....
1) There are several charts that I wish to bring into my file that are which happen to be what I like to call 'entire tabs.' Meaning the actual chart itself takes up the entire tab. I couldn't find a chart # like I did with other charts that did not take up entire tabs, so I solved this by literally grabbing the entire tab and copying it to the end of my file. But by doing this it loses the formatting of the dates, ie: 12/31/2011 turns into the Julian date format. Is there such a code where I can copy just a picture of the tab rather than the entire tab?
2) When I paste the table/chart into the 'tables & charts' tab I made the macro leave 40 spaces in between each image, because some images are larger than others and I don't want overlapping. Is there a code to have the pictures automatically be right below each other when pasting - so that I don't have ~50 pictures spanning ~2000 cells?
Please let me know if I am not being specific enough with what I am trying to do and if you would like me to clarify anything. Any help would be MUCH appreciated! : pray2:
My test file is attached. You can see the code below.
'THIS MACRO OPENS THE VARIOUS FILES USED IN THE BSM REPORT AND COMPILES THE DESIRED PIECES IN ONE LOCATION
Sub updateDocx()
'THIS SECTION HIDES ANY MESSAGES/ALERTS
'************************************************************************** ************
Application.DisplayAlerts = False
'VARIABLE TYPES ARE DEFINED BELOW
'************************************************************************** ************
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim j As Integer
Dim currPath As String
Dim currwb As String
Dim tableChartFlag As String
Dim FileLocation As String
Dim FileName As String
Dim tabName As String
Dim RangeName As String
Dim i As Integer
currPath = ActiveWorkbook.Path
currwb = ActiveWorkbook.Name
'THIS CLEARS THE 'TABLES & CHARTS' TAB
'************************************************************************** ************
Sheets("Tables & Charts").Delete
Sheets.Add.Name = "Tables & Charts"
Sheets("Tables & Charts").Select
'THIS DELETES ANY EXTRA TABS
'************************************************************************** ************
While Sheets.Count > 5
Sheets(Sheets.Count).Delete
Wend
'THIS SPECIFIES THE START ROW FOR THE MACRO
'************************************************************************** ************
i = Sheets("Control").Cells(2, 2)
'THIS SECTION USES THE INFORMATION IN THE CONTROL TAB TO LOCATE THE DESIRED OBJECTS
'************************************************************************** ************
While Not IsEmpty(Sheets("Control").Cells(i, 7))
FileLocation = Sheets("Control").Cells(i, 3).Value
FileName = Sheets("Control").Cells(i, 4).Value
tabName = Sheets("Control").Cells(i, 5).Value
RangeName = Sheets("Control").Cells(i, 6).Value
'THIS LOOP SKIPS ITEMS WHICH ARE NO LONGER INCLUDED IN THE REPORT VIA THE RANGE COLUMN
'************************************************************************** ************
If RangeName = "" Then GoTo aaa
'THIS SPECIFIES IF AN OBJECT IS A TABLE VS. CHART
'************************************************************************** ************
On Error Resume Next
tableChartFlag = WorksheetFunction.Find(":", RangeName, 1)
If Err.Number = 1004 Then
tableChartFlag = "C"
Else: tableChartFlag = "T"
End If
On Error Resume Next
Windows(FileName).Activate
If Err.Number <> 0 Then
Workbooks.Open FileName:=FileLocation & "\" & FileName
If Err.Number = 1004 Then
MsgBox ("On Row " & i & " " & Err.Description)
GoTo bbb
End If
End If
'THIS SECTION COPIES THE DESIRED OBJECT - USING 'COPY AS PICTURE'
'************************************************************************** ************
Sheets(tabName).Select
'FOR TABLE/CHART
If tableChartFlag = "T" Then
Range(RangeName).Select
ElseIf tableChartFlag = "C" Then ActiveSheet.ChartObjects(RangeName).Activate
Else: MsgBox ("Table/Chart Flag missing!!")
End If
'FOR ENTIRE TAB - THIS CREATES AN ADDITIONAL TAB AT THE END OF THE FILE
If RangeName = "ENTIRE TAB" Then
Sheets(tabName).Select
Sheets(tabName).Copy After:=Workbooks(currwb).Sheets(Workbooks(currwb).Sheets.Count)
Else
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End If
'THIS RETURNS TO THE BSM REPORT CREATION FILE AND PASTES THE OBJECT 'AS A PICTURE'
'************************************************************************** ************
Windows(currwb).Activate
Sheets("Tables & Charts").Select
'THIS LEAVES A GAP OF 40 CELLS BETWEEN PASTED OBJECTS
ActiveCell.Offset(0, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(40, 0).Select
'THIS CLOSES THE FILE FROM WHICH AN OBJECT WAS RETRIEVED
'************************************************************************** ************
If FileName <> Sheets("Control").Cells(i + 1, 4).Value Then
Windows(FileName).Activate
ActiveWorkbook.Close
End If
'LOOPS
'************************************************************************** ************
aaa:
i = i + 1
Wend
bbb:
End Sub