I extracted the values of each cell from the table in word document, and I created charts based on those values. The charts are fine.
However, it keep insert at the first page. Does anyone know how can I insert my chart in at same position in each page?
The word document generated by Mail Merge. Will that cause the problem?
Also, dose anyone know how to insert a chart into table cell?
Dim pge As Page
Dim i As Integer
i = 3
Dim j As Integer
j = 1
For peg = 1 To Selection.Information(wdNumberOfPagesInDocument)
Dim tTable As Table
Set tTable = ActiveDocument.Tables(i)
Set cTable = ActiveDocument.Tables(j)
Dim wChart As Chart
Dim chartWorkSheet As Excel.Worksheet
Dim ThisYrSumCon As Integer
Dim ThisYrWinCon As Integer
Dim PreYrSumCon As Integer
Dim PreYrWinCon As Integer
Dim BefPreYrSumCon As Integer
Dim BefPreYrWinCon As Integer
'•
ThisYrSumCon = CInt(Left(tTable.Cell(2, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
ThisYrWinCon = CInt(Left(tTable.Cell(3, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text) - 1))
PreYrSumCon = CInt(Left(tTable.Cell(2, 3).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
PreYrWinCon = CInt(Left(tTable.Cell(3, 3).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
BePreYrSumCon = CInt(Left(tTable.Cell(2, 4).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
BePreYrWinCon = CInt(Left(tTable.Cell(3, 4).Range.Text, Len(tTable.Cell(3, 2).Range.Text)))
'MsgBox (ThisYrSumCon)
'cTable.Cell(3, 4).Range.Text = "test"
'cTable.Cell(12, 3).Range.Text = "test"
Set wChart = ActiveDocument.Shapes.AddChart.Chart
With wChart.Parent
.Top = 105
.Left = 205
.Width = 300
.Height = 150
End With
Set chartWorkSheet = wChart.ChartData.Workbook.WorkSheets(1)
chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:G2")
chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Water Consumption Records"
wChart.ChartType = xlColumnClustered
chartWorkSheet.Range("A1").FormulaR1C1 = ""
chartWorkSheet.Range("B1").FormulaR1C1 = "2012 Summer"
chartWorkSheet.Range("C1").FormulaR1C1 = "2012 Winter"
chartWorkSheet.Range("D1").FormulaR1C1 = "2013 Summer"
chartWorkSheet.Range("E1").FormulaR1C1 = "2013 Winter"
chartWorkSheet.Range("F1").FormulaR1C1 = "2014 Summer"
chartWorkSheet.Range("G1").FormulaR1C1 = "2014 Winter"
chartWorkSheet.Range("A2").FormulaR1C1 = ""
chartWorkSheet.Range("B2").FormulaR1C1 = BePreYrSumCon
chartWorkSheet.Range("C2").FormulaR1C1 = BePreYrWinCon
chartWorkSheet.Range("D2").FormulaR1C1 = PreYrSumCon
chartWorkSheet.Range("E2").FormulaR1C1 = PreYrWinCon
chartWorkSheet.Range("F2").FormulaR1C1 = ThisYrSumCon
chartWorkSheet.Range("G2").FormulaR1C1 = ThisYrWinCon
wChart.ChartData.Workbook.Application.Quit
i = i + 5
j = j + 5
Selection.GoTo What:=wdGoToPage, Which:=lNextPage
Next
Lol, I am so happy that I can answer my own question... :)
Here's the answer for creating a chart base on the same format word table in each page, and put the chart at same spot each page.
The i Integer is for me to find the same table in each page.
Dim Rng As Range, pg As Long
Dim i As Integer
i = 3
With ActiveDocument
Set Rng = .Range(0, 0)
For pg = 1 To .ComputeStatistics(wdStatisticPages)
Set Rng = Rng.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pg)
Rng.Collapse wdCollapseStart
Dim tTable As Table
Set tTable = ActiveDocument.Tables(i)
Dim wChart As Chart
Dim chartWorkSheet As Excel.Worksheet
Dim ThisYrSumCon As Integer
Dim ThisYrWinCon As Integer
Dim PreYrSumCon As Integer
Dim PreYrWinCon As Integer
Dim BefPreYrSumCon As Integer
Dim BefPreYrWinCon As Integer
ThisYrSumCon = CInt(Left(tTable.Cell(2, 2).Range.Text, Len(tTable.Cell(2, 2).Range.Text) - 1))
ThisYrWinCon = CInt(Left(tTable.Cell(3, 2).Range.Text, Len(tTable.Cell(3, 2).Range.Text) - 1))
PreYrSumCon = CInt(Left(tTable.Cell(2, 3).Range.Text, Len(tTable.Cell(2, 3).Range.Text) - 1))
PreYrWinCon = CInt(Left(tTable.Cell(3, 3).Range.Text, Len(tTable.Cell(3, 3).Range.Text) - 1))
BePreYrSumCon = CInt(Left(tTable.Cell(2, 4).Range.Text, Len(tTable.Cell(2, 4).Range.Text) - 1))
BePreYrWinCon = CInt(Left(tTable.Cell(3, 4).Range.Text, Len(tTable.Cell(3, 4).Range.Text) - 1))
Set wChart = .Shapes.AddChart(xlColumnClustered, 270, 105, 230, 150, Rng).Chart
Set chartWorkSheet = wChart.ChartData.Workbook.WorkSheets(1)
chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.Range("A1:G2")
chartWorkSheet.Range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Water Consumption Records"
chartWorkSheet.Range("A1").FormulaR1C1 = ""
chartWorkSheet.Range("B1").FormulaR1C1 = "2012 Summer"
chartWorkSheet.Range("C1").FormulaR1C1 = "2012 Winter"
chartWorkSheet.Range("D1").FormulaR1C1 = "2013 Summer"
chartWorkSheet.Range("E1").FormulaR1C1 = "2013 Winter"
chartWorkSheet.Range("F1").FormulaR1C1 = "2014 Summer"
chartWorkSheet.Range("G1").FormulaR1C1 = "2014 Winter"
chartWorkSheet.Range("A2").FormulaR1C1 = ""
chartWorkSheet.Range("B2").FormulaR1C1 = BePreYrSumCon
chartWorkSheet.Range("C2").FormulaR1C1 = BePreYrWinCon
chartWorkSheet.Range("D2").FormulaR1C1 = PreYrSumCon
chartWorkSheet.Range("E2").FormulaR1C1 = PreYrWinCon
chartWorkSheet.Range("F2").FormulaR1C1 = ThisYrSumCon
chartWorkSheet.Range("G2").FormulaR1C1 = ThisYrWinCon
wChart.ChartData.Workbook.Application.Quit
i = i + 5
j = j + 5
Next
End With
Related
I have in cells A1 19,200, B1 13/05/2020 and cells C1 72. When i execute the VBA a table is created in Word as per below and it continues to 72
Instal No Amt(Rs) Due Date Instal No Amt(Rs) Due Date
1 19200 13/05/2020
2 19200 13/06/2020
3 19200 13/07/2020
4 19200 13/08/2020
5 19200 13/09/2020
6 19200 13/10/2020
7 19200 13/11/2020
8 19200 13/12/2020
9 19200 13/01/2021
10 19200 13/02/2021
11 19200 13/03/2021
12 19200 13/04/2021
13 19200 13/05/2021
14 19200 13/06/2021
15 19200 13/07/2021
16 19200 13/08/2021
Please note that C1 is the number of months(i,e Instal No).
What i want to achieve is to fill the other part to the right of the blank of the table.Let me clarify if C1= 72 months then split it half that is send 36 months to the other side of the table.My number of months are even numbers(24,36,48,60,98)
You will notice that i have added 1 to "lngRows = Range("C1").Value + 1" because of the headings
my codes are as follows :-
Sub CreateTableInWord()
Dim objWord As Object
Dim objDoc As Object
Dim objTbl As Object
Dim objRow As Object
Dim objCol As Object
Dim lngCols As Long
Dim lngRows As Long
Dim I As Long
lngCols = 6
lngRows = 72
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add(DocumentType:=0)
Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=lngRows, NumColumns:=lngCols)
Set objRow = objTbl.Rows(1)
objTbl.Cell(1, 1).Range.Text = "Instal No"
objTbl.Cell(1, 1).Range.Bold = True
objTbl.Cell(1, 2).Range.Text = "Amt(Rs)"
objTbl.Cell(1, 2).Range.Bold = True
objTbl.Cell(1, 3).Range.Text = "Due Date"
objTbl.Cell(2, 3) = Range("B1").Value
objTbl.Cell(1, 3).Range.Bold = True
objTbl.Cell(1, 4).Range.Text = "Instal No"
objTbl.Cell(1, 4).Range.Bold = True
objTbl.Cell(1, 5).Range.Text = "Amt(Rs)"
objTbl.Cell(1, 5).Range.Bold = True
objTbl.Cell(1, 6).Range.Text = "Due Date"
objTbl.Cell(1, 6).Range.Bold = True
objTbl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
For I = 2 To lngRows
' For j = 1 To intNoOfColumns
objTbl.Cell(I, 1).Range = I - 1
Next
For S = 2 To lngRows
objTbl.Cell(S, 2) = Range("A1").Value
Next
For T = 2 To lngRows
objTbl.Cell(T, 3).Range.Text = Format(DateAdd("m", T - 2, Range("B1").Value), "dd/mm/yyyy")
Next T
Set objCol = Nothing
Set objRow = Nothing
Set objDoc = Nothing
Set objWord = Nothing
End Sub
Try this out:
Sub CreateTableInWord()
Dim objWord As Object, objDoc As Object, objTbl As Object, objRow As Object
Dim objCol As Object, colSets As Long, numMonths As Long, i As Long, n As Long, c As Long
Dim amt, dtStart, tblRows As Long, tblCols As Long, rw As Long, col As Long
numMonths = Range("A1").Value
amt = Range("B1").Value
dtStart = Range("C1").Value
colSets = Range("D1").Value 'how many sets of columns ?
tblRows = 1 + Application.Ceiling(numMonths / colSets, 1) 'how many table rows?
tblCols = colSets * 3 'how many table cols?
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add(DocumentType:=0)
Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, _
NumRows:=tblRows, NumColumns:=tblCols)
c = 0
For n = 1 To colSets
objTbl.Cell(1, c + 1).Range.Text = "Instal No"
objTbl.Cell(1, c + 1).Range.Bold = True
objTbl.Cell(1, c + 2).Range.Text = "Amt(Rs)"
objTbl.Cell(1, c + 2).Range.Bold = True
objTbl.Cell(1, c + 3).Range.Text = "Due Date"
objTbl.Cell(1, c + 3).Range.Bold = True
c = c + 3
Next n
objTbl.Range.ParagraphFormat.Alignment = 1 ' wdAlignParagraphCenter
rw = 2
col = 0
For i = 1 To numMonths
'rw = 1 + Application.Ceiling(i / colSets, 1) 'fill across and then down
rw = IIf(i Mod (tblRows - 1) = 1, 2, rw + 1) 'fill down then across
objTbl.Cell(rw, col + 1).Range.Text = i
objTbl.Cell(rw, col + 2).Range.Text = amt
objTbl.Cell(rw, col + 3).Range.Text = DateAdd("m", i - 1, dtStart)
'col = IIf(i Mod colSets = 0, 0, col + 3) 'fill across and then down
col = IIf(i Mod (tblRows - 1) = 0, col + 3, col) 'fill down and then across
Next i
End Sub
I'm trying to download table data of a webpage but it looks like that the webpage is too big.
If I put the ".response" data in a "String"-variable, and save it to a textfile, I'll get all the data what is on the webpage. If I do this after saving it to an "HTMLDocument"-variable I only get the first 51594 characters
This is my script:
Sub nemigaparts_articles()
Dim oHtml As HTMLDocument
Dim oElement As Object
Dim URL As String
Dim id As String
Dim z As Long
Dim y As Long
Dim row As Long
Dim totaal As Long
Dim begin As Long
'data for save as
Dim start As Long
Dim eind As Long
Application.ScreenUpdating = False
begin = 1
totaal = 2
row = 1
start = 1
eind = 0
'laat statusbalk zien
UserForm1.Show
For z = begin To totaal Step 1
'get page data
'URL = Sheets("drawings").Cells(z, 3).Value
'id = Sheets("drawings").Cells(z, 1).Value
URL = "https://nemigaparts.com/cat_spares/pet/porsche/964/13/902000/"
id = 1
Set oHtml = New HTMLDocument
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", LCase(URL), False
.send
oHtml.body.innerHTML = .responseText
End With
Sheets("articles").Cells(1, 11) = z
Dim imageurl As Object
Set imageurl = oHtml.getElementsByClassName("col-lg-9 col-md-9 col-sm-9 col-xs-12 xs-margin-bottom-50")(0)
URL_img = imageurl.getElementsByTagName("a")(0).href
Dim atribuut As Object
Set atribuut = oHtml.getElementsByClassName("technical")(0)
If Not atribuut Is Nothing Then
x = oHtml.getElementsByTagName("tr").Length - 1
MsgBox (x)
For y = 1 To x Step 1
Sheets("articles").Cells(row, 1) = id
Sheets("articles").Cells(row, 2) = URL_img
Sheets("articles").Cells(row, 3) = oHtml.getElementsByTagName("tr")(y).innerHTML
row = row + 1
Next
End If
DoEvents
UserForm1.Label2.Width = (z / totaal * 100) / 100 * 186
UserForm1.Label4.Caption = "Artikel " & z & " van " & totaal
Next
End Sub
After 2 days trying to find a solution to my problem, I need your help please.
I'm working on powerpoint VBA script, and I've got a Table (3,3). In the row 1, I've already input some string in cells.
I want to know why my script doesn't want to write NOK in cells when the string does'nt match "comp" for example
Here is my VBA script:
Public Sub CreateTable1()
' déclaration of variables
Dim objSld As Slide
Dim objShp As Shape
Dim foundText1 As Object
Dim FindWhat As String
Dim I As Integer
Dim j As Integer
Set objSld = ActivePresentation.Slides(1)
Set objShp = objSld.Shapes.AddTable(3, 3, 15, 150, 700, 500)
' Give a name to table
objShp.Name = "Table1"
' Define size of cells
With objSld.Shapes("Table1").Table
.Columns(1).Width = 115
.Columns(2).Width = 115
.Columns(3).Width = 115
.Rows(1).Height = 120
.Rows(2).Height = 120
.Rows(3).Height = 120
'Write in cells
With .Cell(1, 1).Shape.TextFrame
.TextRange.Text = "Composition"
End With
With .Cell(2, 1).Shape.TextFrame
.TextRange.Text = "Material"
End With
With .Cell(3, 1).Shape.TextFrame
.TextRange.Text = "Method"
End With
' Define text position
For I = 1 To 3
For j = 1 To 3
With .Cell(j, I).Shape.TextFrame
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
.TextRange.Font.Size = 18
End With
Next j
Next I
'Command find
'Browse row 1 from line 1 to 3
For x = 1 To 3
Set foundText1 = objSld.Shapes("Table1").Table.Cell(x, 1).Shape.TextFrame.TextRange.Find(FindWhat:="Comp")
If foundText1 = "Comp" Then
'MsgBox foundText1 & x
'Will write in cell (x,2) OK and x
objSld.Shapes("Table1").Table.Cell(x, 2).Shape.TextFrame.TextRange.Text = "OK " & x
Else
'Will write in cell (x,2) NOK and x
'Doesn't works !! Why??
objSld.Shapes("Table1").Table.Cell(x, 2).Shape.TextFrame.TextRange.Text = "NOK " & x
End If
Next x
End With
End Sub
I Would like to know if you see where is the mistake. The function Else seems not working..
I found the solution !!
For those who're lost with this same problem, here is my code:
Public Sub CreateTable1()
' déclaration of variables
Dim objSld As Slide
Dim objShp As Shape
Dim foundText1 As Object
Dim TextRng As TextRange
Dim FindWhat As String
Dim I As Integer
Dim j As Integer
Set objSld = ActivePresentation.Slides(8)
Set objShp = objSld.Shapes.AddTable(3, 3, 15, 150, 700, 500)
' Give a name to table
objShp.Name = "Table1"
' Define size of cells
With objSld.Shapes("Table1").Table
.Columns(1).Width = 115
.Columns(2).Width = 115
.Columns(3).Width = 115
.Rows(1).Height = 120
.Rows(2).Height = 120
.Rows(3).Height = 120
'Write in cells
With .Cell(1, 1).Shape.TextFrame
.TextRange.Text = "Composition"
End With
With .Cell(2, 1).Shape.TextFrame
.TextRange.Text = "Material"
End With
With .Cell(3, 1).Shape.TextFrame
.TextRange.Text = "Method"
End With
' Define text position
For I = 1 To 3
For j = 1 To 3
With .Cell(j, I).Shape.TextFrame
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
.TextRange.Font.Size = 18
End With
Next j
Next I
'Command find
'Browse row 1 from line 1 to 3
End With
End Sub
Creation of a second sub to understand where does script failed
Sub yolo()
Dim objSld As Slide
Dim oTbl As Table
Dim lRow As Long
Dim lCol As Long
Dim foundText1 As Object
Set objSld = ActivePresentation.Slides(8)
Set oTbl = objSld.Shapes("Table1").Table
With oTbl
For lRow = 1 To .Rows.Count
With .Cell(lRow, 1).Shape
'Do something with each cell's text
'Does this shape has text?
If .HasTextFrame Then
Set TextRng = oTbl.Cell(lRow, 1).Shape.TextFrame.TextRange
Set foundText1 = TextRng.Find(FindWhat:="Comp")
Do While Not (foundText1 Is Nothing)
With foundText1
oTbl.Cell(lRow, 2).Shape.TextFrame.TextRange.Text = "OK"
Set foundText1 = TextRng.Find(FindWhat:="Comp", After:=.Start + .Length - 1)
End With
Loop
End If
End With
Next lRow
End With
End Sub
I have an application that can retrieves the install date and save it at a datagridview column with the format of date only.
But when I tried to export it to an excel file, even when I tried to format the cell, it still shows me datetime instead of date only for some of the data.
The code for exporting is shown below. btw I'm using vb.net
'reportFile : True = IE_Version_Report.xlsx False = Data.xlsx
Sub ExportData(reportFile)
Dim dSet As New DataSet
dSet.Tables.Add()
For i As Integer = 0 To DataGridView1.ColumnCount - 1
dSet.Tables(0).Columns.Add(DataGridView1.Columns(i).HeaderText)
Next
Dim dr As DataRow
For i As Integer = 0 To DataGridView1.RowCount - 1
dr = dSet.Tables(0).NewRow
For j As Integer = 0 To DataGridView1.Columns.Count - 1
dr(j) = DataGridView1.Rows(i).Cells(j).Value
Next
dSet.Tables(0).Rows.Add(dr)
Next
Dim Ex As Microsoft.Office.Interop.Excel.Application
Dim Wb As Microsoft.Office.Interop.Excel.Workbook
Dim Ws As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Ex = New Microsoft.Office.Interop.Excel.Application
Wb = Ex.Workbooks.Add(misValue)
Ws = Wb.Sheets("sheet1")
Dim dt As DataTable = dSet.Tables(0)
Dim col, row As Integer
Dim rawData(dt.Rows.Count, dt.Columns.Count - 1) As Object
For col = 0 To dt.Columns.Count - 1
rawData(0, col) = dt.Columns(col).ColumnName.ToUpper
Next
For col = 0 To dt.Columns.Count - 1
For row = 0 To dt.Rows.Count - 1
rawData(row + 1, col) = dt.Rows(row).ItemArray(col)
Next
Next
Dim finalColLetter As String = String.Empty
finalColLetter = ExcelColName(dt.Columns.Count)
Dim excelRange As String = String.Format("A1:{0}{1}", finalColLetter, dt.Rows.Count + 1)
Ws.Range(excelRange, Type.Missing).Value2 = rawData
Ws.Range("A1:L1").EntireColumn.AutoFit() 'columns in excel file will autofit according to the data
Dim num As Integer = DataGridView1.Rows.Count + 1
'set the format for dates in these few columns
Ws.Range("D2:D" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("F2:F" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("H2:H" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("J2:J" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("L2:L" & num).NumberFormat = "dd/mm/yyyy;#"
Ws = Nothing
If reportFile = True Then
fileExported = True
If System.IO.File.Exists(FolderPath & "\MSOffice_Report.xlsx") Then
System.IO.File.Delete(FolderPath & "\MSOffice_Report.xlsx")
End If
Wb.SaveAs(FolderPath & "\MSOffice_Report.xlsx")
Else
fileExported = False
If System.IO.File.Exists("C:\Install\MSData.xlsx") Then
System.IO.File.Delete("C:\Install\MSData.xlsx")
End If
Wb.SaveAs("C:\Install\MSData.xlsx")
SetAttr("C:\Install\MSData.xlsx", vbHidden)
End If
Wb.Close(True)
Wb = Nothing
Ex.Quit()
Ex = Nothing
GC.Collect()
End Sub
Public Function ExcelColName(ByVal Col As Integer) As String
If Col < 0 And Col > 256 Then
MsgBox("Invalid Argument", MsgBoxStyle.Critical)
Return Nothing
Exit Function
End If
Dim i As Int16
Dim r As Int16
Dim S As String
If Col <= 26 Then
S = Chr(Col + 64)
Else
r = Col Mod 26
i = System.Math.Floor(Col / 26)
If r = 0 Then
r = 26
i = i - 1
End If
S = Chr(i + 64) & Chr(r + 64)
End If
ExcelColName = S
End Function
Sorry if it's a very stupid question but I really don't know what's wrong with it.
Thanks!
Excel does not recognise dates earlier than 1/1/1900 and will treat a value like 11/11/1111 12:00:00 AM as text. See how the dates are right-aligned and the text is left aligned in your screenshot?
Text will not be affected by the number formatting you apply to show only the date of the values.
Depending on what you want to achieve, you need to adjust your code to handle the text values differently. Replace them with 1/1/1900 or some such.
With the code below I am receiving the 438 error when I try to move a slide to a section that has already been created. Last 4 lines of the code.
Sorry if this code is not clear, but I am new to VBA.
Private Sub CopyandPastetoPPT(Counter As Integer)
Dim NextShape As Integer
Dim IssueName As String
Dim IssueDesc As String
Dim CfoNumber As String
Dim IndName As String
Dim Cat1 As Variant
IssueName = Worksheets("Data_Sheet").Cells(Counter, 1)
IssueDesc = Worksheets("Data_Sheet").Cells(Counter, 3)
CfoNumber = Worksheets("Data_Sheet").Cells(Counter, 5)
IndName = Worksheets("Data_Sheet").Cells(Counter, 7)
Cat1 = Worksheets("Data_Sheet").Cells(Counter, 9)
Set PP_Slide = PP_File.Slides(Counter + 1)
PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
Left:=0, Top:=0, Width:=276, Height:=59
NextShape = PP_Slide.Shapes.Count
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = IssueName
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 16
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbBlack
PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
Left:=276, Top:=0, Width:=153, Height:=59
NextShape = PP_Slide.Shapes.Count
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = IssueDesc
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 16
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbWhite
PP_Slide.Shapes(NextShape).TextFrame.TextRange.ParagraphFormat.SpaceBefore = 0
PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
PP_Slide.Shapes(NextShape).Fill.BackColor.RGB = RGB(0, 0, 0)
PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
Left:=199, Top:=59, Width:=77, Height:=30
NextShape = PP_Slide.Shapes.Count
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = CfoNumber
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 10
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Bold = False
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbBlack
PP_Slide.Shapes(NextShape).TextFrame.TextRange.ParagraphFormat.SpaceBefore = 0
PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
PP_Slide.Shapes(NextShape).Line.Visible = False
PP_Slide.Shapes.AddShape Type:=msoShapeRectangle, _
Left:=597, Top:=507, Width:=123, Height:=18
NextShape = PP_Slide.Shapes.Count
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Text = IndName
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Size = 10
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Italic = True
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Bold = False
PP_Slide.Shapes(NextShape).TextFrame.TextRange.Font.Color = vbBlack
PP_Slide.Shapes(NextShape).TextFrame.TextRange.ParagraphFormat.SpaceBefore = 0
PP_Slide.Shapes(NextShape).TextFrame.VerticalAnchor = msoAnchorMiddle
PP_Slide.Shapes(NextShape).Line.Visible = False
If Cat1 = "Center Consoles" Then
PP_Slide.MoveToSection "Center Consoles"
End If
End Sub