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
Related
I've written this code but the code fails to remove the chart titles when it is run. If I run the code manually using the step-in function it works perfectly.
I've tried using Application.Wait before the newChart.HasTitle = False line but it doesn't seem to work either. Any ideas?
Sub InsertPieCharts()
Dim xl As Excel.Application
Dim aTB As Table
Dim aSL As Slide
Dim sh As Shape
Dim newChart As Chart
Dim aTX As Shape
Dim chartAreasWidth As Double, chartAreasHeight As Double, firstLeft As Double, chartsHSpace As Double, chartsLeft As Double, chartsTop As Double, firstTop As Double, chartsVSpace As Double, tHeight As Double, tWidth As Double, cWidth As Double, cHeight As Double
Dim r As Integer, c As Integer
'Measures
chartAreasWidth = 25 'cm
chartAreasHeight = 4.4 'cm
firstLeft = 3.13 'cm
firstTop = 13.01 'cm
tHeight = 1 'cm
tWidth = 1 'cm
cWidth = 2.5 'cm
cHeight = 2.2 'cm
'Objects
Set xl = CreateObject("Excel.Application")
Set aSL = ActivePresentation.Slides(16)
For Each sh In aSL.Shapes
If sh.HasTable Then
If sh.Table.Cell(1, 1).Shape.TextFrame2.TextRange = "Datatable" Then
Set aTB = sh.Table
Exit For
End If
End If
Next sh
chartsHSpace = xl.CentimetersToPoints(chartAreasWidth / (aTB.Columns.Count - 1))
chartsVSpace = xl.CentimetersToPoints(chartAreasHeight / (aTB.Rows.Count - 2))
chartsLeft = xl.CentimetersToPoints(firstLeft)
chartsTop = xl.CentimetersToPoints(firstTop)
tHeight = xl.CentimetersToPoints(tHeight)
tWidth = xl.CentimetersToPoints(tWidth)
cHeight = xl.CentimetersToPoints(cHeight)
cWidth = xl.CentimetersToPoints(cWidth)
For r = 3 To aTB.Rows.Count
For c = 2 To aTB.Columns.Count
Set newChart = aSL.Shapes.AddChart2(-1, xlPie, chartsLeft - (cWidth - tWidth) / 2 + cWidth * (c - 2), chartsTop - (cHeight - tHeight) / 2 + cHeight * (r - 3), cWidth, cHeight).Chart
With newChart.ChartData.Workbook.Sheets(1)
.Cells(1, 2).Value = ""
.Cells(2, 1).Value = "Fill"
.Cells(2, 2).Value = aTB.Cell(r, c).Shape.TextFrame2.TextRange * 1
.Cells(3, 2).Value = 100 - aTB.Cell(r, c).Shape.TextFrame2.TextRange
.Cells(3, 1).Value = "Unfill"
.Rows(4).Delete
.Rows(4).Delete
End With
newChart.ChartData.Workbook.Close
If newChart.HasTitle = True Then
newChart.HasTitle = False
End If
If newChart.HasLegend = True Then
newChart.HasLegend = False
End If
newChart.SeriesCollection(1).Points(1).Format.Fill.ForeColor.RGB = RGB(176, 176, 176)
newChart.SeriesCollection(1).Points(2).Format.Fill.Visible = False
Set aTX = aSL.Shapes.AddTextbox(msoTextOrientationHorizontal, chartsLeft + chartsHSpace * (c - 2), chartsTop + chartsVSpace * (r - 3), tWidth, tHeight)
aTX.TextFrame2.TextRange = aTB.Cell(r, c).Shape.TextFrame2.TextRange
aTX.TextFrame2.HorizontalAnchor = msoAnchorCenter
aTX.TextFrame2.VerticalAnchor = msoAnchorMiddle
aTX.AutoShapeType = msoShapeOval
If aTB.Cell(r, c).Shape.TextFrame2.TextRange > 89.5 Then
aTX.TextFrame2.TextRange.Font.Size = 14
aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
aTX.Fill.ForeColor.RGB = RGB(47, 105, 151)
ElseIf aTB.Cell(r, c).Shape.TextFrame2.TextRange > 79.5 Then
aTX.TextFrame2.TextRange.Font.Size = 14
aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
aTX.Fill.ForeColor.RGB = RGB(169, 202, 228)
ElseIf aTB.Cell(r, c).Shape.TextFrame2.TextRange > 69.5 Then
aTX.TextFrame2.TextRange.Font.Size = 14
aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
aTX.Fill.ForeColor.RGB = RGB(255, 170, 170)
ElseIf aTB.Cell(r, c).Shape.TextFrame2.TextRange >= 0 Then
aTX.TextFrame2.TextRange.Font.Size = 14
aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
aTX.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
If aTB.Cell(r, c).Shape.TextFrame2.TextRange > 99.5 Then
aTX.TextFrame2.TextRange.Font.Size = 12
Else
aTX.TextFrame2.TextRange.Font.Size = 14
End If
aTX.Width = tWidth
aTX.Height = tHeight
Next c
Next r
End Sub
The solution to my own problem seems to first force the chart titles and then removing them like this
newChart.HasTitle = True
newChart.HasTitle = False
instead of
If newChart.HasTitle = True Then
newChart.HasTitle = False
End If
I want to control SAP from access to print a barcode label just by pressing a button in access.
Currently I have a script that only works if SAP is open
session.findById("wnd[0]/tbar[0]/okcd").Text ="pickLabel"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtY_P_MAT").Text = "testbox"
session.findById("wnd[0]/usr/txtY_P_QUA").Text = "1"
session.findById("wnd[0]/usr/ctxtY_P_LGN").Text = "test"
session.findById("wnd[0]/usr/ctxtY_P_PRI").Text = "testPrinter"
session.findById("wnd[0]/usr/txtY_P_KSC").Text = "test"
session.findById("wnd[0]/usr/txtY_P_KSC").SetFocus
session.findById("wnd[0]/usr/txtY_P_KSC").caretPosition = 4
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[8]").press
I would like to have a way to do it without having SAP open.
Also I need to record the barcode number, but in the screen this number is not shown.
Any idea?
Thanks!!!
I might have a solution for you.
I too needed SAP to print stickers on my Zebra Z4Mplus sticker printer.
What I did was use excel to generate my sticker and send them directly to the printer
First step was installing the printer, it is a TCP/IP printer that you have to connect directly to. The printer had a function to print all settings, I did that then used windows advanced printer setup, create a local TCP/IP port for the printer and added it. Google made this step easy.
Then in excel I inserted a chart on my worksheet.
then I created a shape and created the following code.
This code is an example, my code is much bigger, you need to generate all elements.
I used the GetPrinterFullNames function from pixcels.nl/set-activeprinter-excel/
For barcodes I used the following class stackoverflow.com/questions/13909248/generating-code-128-barcodes-using-excel-vba
You need to find the code128.fft file, I don't remember where I got it.
I also have a module for adding font to system without being administrator (using AddFontResource), storing font in excel worksheet
I got this module from this thread
http://www.mrexcel.com/forum/excel-questions/328457-how-do-you-embed-font-into-excel-file.html
So here is my code for printer my stickers.
Sub PrintExportControl()
Dim myprinter As String
Dim PrintersList() As String
Dim printer_name As String
Dim x As Long
GenerateExportControl
myprinter = Application.ActivePrinter
PrintersList() = GetPrinterFullNames
For x = 1 To UBound(PrintersList)
If InStr(1, PrintersList(x), "ExportControl", vbTextCompare) > 0 Then _
printer_name = PrintersList(x)
Next x
Application.ActivePrinter = printer_name
DoEvents
Sheet1.Shapes("chtExportControl").Chart.PrintOut , , , , "ExportControl"
Sheet1.Shapes("chtExportControl").Chart.PrintOut , , , , "ExportControl"
'Sheet1.Shapes("chtZSMI").Chart.PrintOut , , , , "ExportControl"
'Sheet1.Shapes("chtZSMI").Chart.PrintOut , , , , "ExportControl"
Application.ActivePrinter = myprinter
End Sub
And here is my code for generating the chart which has the sticker on it
Sub GenerateExportControl()
Dim mychart As Chart
Dim picLogo As Shape
Dim shpExportControl As Shape
Dim shpDate As Shape
Dim shpBadge As Shape
Dim shpPN As Shape
Dim shpSN As Shape
Dim shpESN As Shape
Dim shpPartDescription As Shape
Dim shpCSOrder As Shape
Dim shpSO As Shape
Dim shpCSOrderBarcode As Shape
Dim shpSOBarcode As Shape
Dim shp1stMil As Shape
Dim shpPUSML As Shape
Dim shpUSML As Shape
Dim shpITARCID As Shape
Dim shpPECCN As Shape
Dim shpECCN As Shape
Dim shpECL As Shape
' Get the TEMP path
Dim FSO As Object, TmpFolder As Object
Set FSO = CreateObject("scripting.filesystemobject")
Set TmpFolder = FSO.GetSpecialFolder(2)
' Focus a cell
ActiveSheet.Range("A92").Select
' Make sure the "Code 128" font is available
If FontIsInstalled("Code 128") = False Then
CreateFontFile
AddFont
End If
Dim BarcodeGenerator As clsBarcode
Set BarcodeGenerator = New clsBarcode
Set mychart = Sheet1.Shapes("chtExportControl").Chart
mychart.Parent.Width = 288
mychart.Parent.Height = 144
mychart.ChartArea.Border.LineStyle = xlNone
For Each MyShape In mychart.Shapes
MyShape.Delete
Next
Set picLogo = mychart.Shapes.AddPicture("C:\Users\pw46487\Desktop\archive\programs\pwc-faded.jpg", msoTrue, msoTrue, 0, 0, 100, 79.39)
picLogo.Left = mychart.Parent.Width / 2 - picLogo.Width / 2
picLogo.Top = mychart.Parent.Height / 2 - picLogo.Height / 2
Set shpExportControl = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 181, 17)
shpExportControl.TextFrame.Characters.Text = "EXPORT CLASSIFICATION"
shpExportControl.TextFrame.Characters.Font.Size = 18
shpExportControl.TextFrame.MarginLeft = 0
shpExportControl.TextFrame.MarginTop = 0
shpExportControl.TextFrame.MarginRight = 0
shpExportControl.TextFrame.MarginBottom = 0
shpExportControl.TextFrame.AutoSize = True
Set shpDate = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 0, 61, 11)
shpDate.TextFrame.Characters.Text = Day(Date) & "-" & MonthName(Month(Date), True) & "-" & Year(Date)
If IsDate(Worksheets("Sheet1").Range("B68")) Then _
shpDate.TextFrame.Characters.Text = Day(Worksheets("Sheet1").Range("B68")) & "-" & _
MonthName(Month(Worksheets("Sheet1").Range("B68")), True) & "-" & _
Year(Worksheets("Sheet1").Range("B68"))
shpDate.TextFrame.Characters.Font.Size = 12
shpDate.TextFrame.MarginLeft = 0
shpDate.TextFrame.MarginTop = 0
shpDate.TextFrame.MarginRight = 0
shpDate.TextFrame.MarginBottom = 0
shpDate.TextFrame.AutoSize = True
shpDate.Left = ((mychart.Parent.Width - shpDate.Width - shpExportControl.Width) / 2) + shpExportControl.Left + shpExportControl.Width
Set shpBadge = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 0, 100, 11)
shpBadge.TextFrame.Characters.Text = "Badge: " & Split(Worksheets("Sheet1").Range("B11"), " ")(0)
shpBadge.TextFrame.Characters.Font.Size = 12
shpBadge.TextFrame.MarginLeft = 0
shpBadge.TextFrame.MarginTop = 0
shpBadge.TextFrame.MarginRight = 0
shpBadge.TextFrame.MarginBottom = 0
shpBadge.TextFrame.AutoSize = True
shpBadge.Top = shpDate.Top + shpDate.Height + 2
shpBadge.Left = ((mychart.Parent.Width - shpBadge.Width - shpExportControl.Width) / 2) + shpExportControl.Left + shpExportControl.Width
Set shpPN = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 4.5, 100, 11)
shpPN.TextFrame.Characters.Text = "PN: " & Worksheets("Sheet1").Range("B1")
shpPN.TextFrame.Characters.Font.Size = 11
shpPN.TextFrame.MarginLeft = 0
shpPN.TextFrame.MarginTop = 0
shpPN.TextFrame.MarginRight = 0
shpPN.TextFrame.MarginBottom = 0
shpPN.TextFrame.AutoSize = True
shpPN.Top = shpBadge.Top + shpBadge.Height - 2
shpPN.Left = mychart.Parent.Width - shpPN.Width
If Worksheets("Sheet1").Range("B1") = "" Then shpPN.Visible = False
Set shpSN = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 4.5, 100, 11)
shpSN.TextFrame.Characters.Text = "SN: " & Worksheets("Sheet1").Range("B4")
shpSN.TextFrame.Characters.Font.Size = 11
shpSN.TextFrame.MarginLeft = 0
shpSN.TextFrame.MarginTop = 0
shpSN.TextFrame.MarginRight = 0
shpSN.TextFrame.MarginBottom = 0
shpSN.TextFrame.AutoSize = True
shpSN.Top = shpPN.Top + shpPN.Height - 2
shpSN.Left = mychart.Parent.Width - shpSN.Width
If Worksheets("Sheet1").Range("B4") = "" Then shpSN.Visible = False
Set shpESN = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 4.5, 100, 11)
shpESN.TextFrame.Characters.Text = "ESN: " & Worksheets("Sheet1").Range("B5")
shpESN.TextFrame.Characters.Font.Size = 11
shpESN.TextFrame.MarginLeft = 0
shpESN.TextFrame.MarginTop = 0
shpESN.TextFrame.MarginRight = 0
shpESN.TextFrame.MarginBottom = 0
shpESN.TextFrame.AutoSize = True
shpESN.Top = shpSN.Top + shpSN.Height - 2
shpESN.Left = mychart.Parent.Width - shpESN.Width
If Worksheets("Sheet1").Range("B5") = "" Then shpESN.Visible = msoFalse
Set shpPartDescription = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 4.5, 100, 11)
shpPartDescription.TextFrame.Characters.Text = Worksheets("Sheet1").Range("B50")
shpPartDescription.TextFrame.Characters.Font.Size = 11
shpPartDescription.TextFrame.MarginLeft = 0
shpPartDescription.TextFrame.MarginTop = 0
shpPartDescription.TextFrame.MarginRight = 0
shpPartDescription.TextFrame.MarginBottom = 0
shpPartDescription.TextFrame.AutoSize = True
shpPartDescription.Top = mychart.Parent.Height - shpPartDescription.Height
shpPartDescription.Left = mychart.Parent.Width - shpPartDescription.Width
Set shpCSOrder = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 4.5, 100, 11)
shpCSOrder.TextFrame.Characters.Text = "CS:" & Worksheets("Sheet1").Range("B48")
shpCSOrder.TextFrame.Characters.Font.Size = 11
shpCSOrder.TextFrame.MarginLeft = 0
shpCSOrder.TextFrame.MarginTop = 0
shpCSOrder.TextFrame.MarginRight = 0
shpCSOrder.TextFrame.MarginBottom = 0
shpCSOrder.TextFrame.AutoSize = True
shpCSOrder.Top = shpPartDescription.Top - shpCSOrder.Height
shpCSOrder.Left = mychart.Parent.Width - shpCSOrder.Width
If Worksheets("Sheet1").Range("B48") = "" Then shpCSOrder.Visible = msoFalse
Sheet1.Shapes("chtBarcode2Pic").Chart.Shapes("TextBox 1").TextFrame.Characters.Text = BarcodeGenerator.Code128_Str(Worksheets("Sheet1").Range("B48"))
' Erase temporary file if exists
If FileExists(TmpFolder & "bufferbarcode.jpg") Then Kill TmpFolder & "bufferbarcode.jpg"
' Output picture of barcode to file
Sheet1.Shapes("chtBarcode2Pic").Chart.Export TmpFolder & "bufferbarcode.jpg", "jpg"
Set shpCSOrderBarcode = mychart.Shapes.AddPicture(TmpFolder & "bufferbarcode.jpg", msoTrue, msoTrue, 0, 0, 100, 22)
shpCSOrderBarcode.Top = shpCSOrder.Top - shpCSOrderBarcode.Height + 3
shpCSOrderBarcode.Left = mychart.Parent.Width - shpCSOrderBarcode.Width + 3
If Worksheets("Sheet1").Range("B48") = "" Then shpCSOrderBarcode.Visible = msoFalse
Set shpSO = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, 185, 4.5, 100, 11)
shpSO.TextFrame.Characters.Text = "SO:" & Worksheets("Sheet1").Range("B29")
shpSO.TextFrame.Characters.Font.Size = 11
shpSO.TextFrame.MarginLeft = 0
shpSO.TextFrame.MarginTop = 0
shpSO.TextFrame.MarginRight = 0
shpSO.TextFrame.MarginBottom = 0
shpSO.TextFrame.AutoSize = True
shpSO.Top = shpCSOrderBarcode.Top - shpSO.Height + 3
shpSO.Left = mychart.Parent.Width - shpSO.Width
If Worksheets("Sheet1").Range("B29") = "" Then shpSO.Visible = msoFalse
Sheet1.Shapes("chtBarcode2Pic").Chart.Shapes("TextBox 1").TextFrame.Characters.Text = BarcodeGenerator.Code128_Str(Worksheets("Sheet1").Range("B29"))
' Erase temporary file if exists
If FileExists(TmpFolder & "bufferbarcode.jpg") Then Kill TmpFolder & "bufferbarcode.jpg"
' Output picture of barcode to file
Sheet1.Shapes("chtBarcode2Pic").Chart.Export TmpFolder & "bufferbarcode.jpg", "jpg"
Set shpSOBarcode = mychart.Shapes.AddPicture(TmpFolder & "bufferbarcode.jpg", msoTrue, msoTrue, 0, 0, 100, 22)
shpSOBarcode.Top = shpSO.Top - shpSOBarcode.Height + 3
shpSOBarcode.Left = mychart.Parent.Width - shpSOBarcode.Width + 3
If Worksheets("Sheet1").Range("B29") = "" Then shpSOBarcode.Visible = msoFalse
Set shp1stMil = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shpExportControl.Top + shpExportControl.Height, 100, 11)
shp1stMil.TextFrame.Characters.Text = "1st MILITARY:(" & Worksheets("Sheet1").Range("B21") & ")"
shp1stMil.TextFrame.Characters.Font.Size = 13
shp1stMil.TextFrame.MarginLeft = 0
shp1stMil.TextFrame.MarginTop = 0
shp1stMil.TextFrame.MarginRight = 0
shp1stMil.TextFrame.MarginBottom = 0
shp1stMil.TextFrame.AutoSize = True
shp1stMil.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B21") = "" Then shp1stMil.Visible = msoFalse
Set shpPUSML = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shp1stMil.Top + shp1stMil.Height, 100, 11)
shpPUSML.TextFrame.Characters.Text = "P-USML:(" & Worksheets("Sheet1").Range("B22") & ")"
shpPUSML.TextFrame.Characters.Font.Size = 13
shpPUSML.TextFrame.MarginLeft = 0
shpPUSML.TextFrame.MarginTop = 0
shpPUSML.TextFrame.MarginRight = 0
shpPUSML.TextFrame.MarginBottom = 0
shpPUSML.TextFrame.AutoSize = True
shpPUSML.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B22") = "" Then shpPUSML.Visible = msoFalse
Set shpUSML = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shpPUSML.Top + shpPUSML.Height, 100, 11)
shpUSML.TextFrame.Characters.Text = "USML:(" & Worksheets("Sheet1").Range("B23") & ")"
shpUSML.TextFrame.Characters.Font.Size = 13
shpUSML.TextFrame.MarginLeft = 0
shpUSML.TextFrame.MarginTop = 0
shpUSML.TextFrame.MarginRight = 0
shpUSML.TextFrame.MarginBottom = 0
shpUSML.TextFrame.AutoSize = True
shpUSML.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B23") = "" Then shpUSML.Visible = msoFalse
Set shpITARCID = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shpUSML.Top + shpUSML.Height, 100, 11)
shpITARCID.TextFrame.Characters.Text = "ITAR CID:(" & Worksheets("Sheet1").Range("B24") & ")"
shpITARCID.TextFrame.Characters.Font.Size = 13
shpITARCID.TextFrame.MarginLeft = 0
shpITARCID.TextFrame.MarginTop = 0
shpITARCID.TextFrame.MarginRight = 0
shpITARCID.TextFrame.MarginBottom = 0
shpITARCID.TextFrame.AutoSize = True
shpITARCID.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B24") = "" Then shpITARCID.Visible = msoFalse
Set shpPECCN = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shpITARCID.Top + shpITARCID.Height, 100, 11)
shpPECCN.TextFrame.Characters.Text = "P-ECCN:(" & Worksheets("Sheet1").Range("B25") & ")"
shpPECCN.TextFrame.Characters.Font.Size = 13
shpPECCN.TextFrame.MarginLeft = 0
shpPECCN.TextFrame.MarginTop = 0
shpPECCN.TextFrame.MarginRight = 0
shpPECCN.TextFrame.MarginBottom = 0
shpPECCN.TextFrame.AutoSize = True
shpPECCN.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B25") = "" Then shpPECCN.Visible = msoFalse
Set shpECCN = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shpPECCN.Top + shpPECCN.Height, 100, 11)
shpECCN.TextFrame.Characters.Text = "ECCN:(" & Worksheets("Sheet1").Range("B26") & ")"
shpECCN.TextFrame.Characters.Font.Size = 13
shpECCN.TextFrame.MarginLeft = 0
shpECCN.TextFrame.MarginTop = 0
shpECCN.TextFrame.MarginRight = 0
shpECCN.TextFrame.MarginBottom = 0
shpECCN.TextFrame.AutoSize = True
shpECCN.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B26") = "" Then shpECCN.Visible = msoFalse
Set shpECL = mychart.Shapes.AddTextbox(msoTextOrientationHorizontal, shpExportControl.Left, shpECCN.Top + shpECCN.Height, 100, 11)
shpECL.TextFrame.Characters.Text = "ECL:(" & Worksheets("Sheet1").Range("B27") & ")"
shpECL.TextFrame.Characters.Font.Size = 13
shpECL.TextFrame.MarginLeft = 0
shpECL.TextFrame.MarginTop = 0
shpECL.TextFrame.MarginRight = 0
shpECL.TextFrame.MarginBottom = 0
shpECL.TextFrame.AutoSize = True
shpECL.Fill.BackColor.RGB = RGB(255, 255, 255)
If Worksheets("Sheet1").Range("B27") = "" Then shpECL.Visible = msoFalse
End Sub
Good luck
I have a code to change the colors of my bars in my bar graph but now it gives me a type mismatch. Please help me fix my code.
Sub UpdateChart()
Dim myChartObj As ChartObject
Dim myChart As Chart
Dim mySeries(1 To 10) As Series
Dim myChartFormat(1 To 10) As ChartFormat
Dim myFillFormat(1 To 10) As FillFormat
Dim myColorFormat(1 To 10) As ColorFormat
ActiveSheet.ChartObjects(1).Activate
Set myChart = ActiveChart
For i = 1 To 10
Set mySeries(i) = myChart.SeriesCollection(i)
Set myChartFormat(i) = mySeries(i).Format
Set myFillFormat(i) = myChartFormat(i).Fill
Set myColorFormat(i) = myFillFormat(i).ForeColor
If i = 1 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 7))
ElseIf i = 2 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 7))
ElseIf i = 3 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 8))
ElseIf i = 4 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 9))
ElseIf i = 5 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 10))
ElseIf i = 6 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 11))
ElseIf i = 7 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 12))
ElseIf i = 8 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 13))
ElseIf i = 9 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 14))
ElseIf i = 10 Then
myColorFormat(i).RGB = getRGB1(Cells(12, 15))
End If
Next i
End Sub
Function getRGB1(rcell) As String
Dim sColor As String
sColor = Right("000000" & Hex(rcell.Interior.Color), 6)
getRGB1 = Right(sColor, 2) & Mid(sColor, 3, 2) & Left(sColor, 2)
End Function
Set the color of each cell in range G12:R12
Option Explicit
Sub UpdateChart()
Dim myChart As Chart
Set myChart = ActiveSheet.ChartObjects(1)
For i = 1 To 10
With myChart.SeriesCollection(1)
.Points(i).Format.Fill.ForeColor.RGB = Cells(12, i + 6).Interior.Color
End With
End Sub
End Sub
I am a VBA newbie and just started learning about loops.
Here's my code:
sub worksheet_change(byval target as range)
application.screenupdating = false
application.enableevents = false
dim book1 as workbooks
dim customer as range, rang as range, jdiskon as range, pelanggan as range, lookharga as range, diskon as range
dim rout(1 to 10) as variant, i as long
set book1 = workbooks("database.xlsx")
set rang = book1.sheets("DB").range("A6:N84")
set look harga book1.sheets("harga").range("B4:E50")
set pelanggan = range("E7")
set alamat = range("E8")
set jdiskon = range("M26")
set diskon = range("P3")
getalamat = application.worksheetfunction.vlookup(pelanggan, rang, 13, false)
jenisdiskon = application.worksheetfunction.vlookup(pelanggan, rang, 10, false)
getdiskon = application.worksheetfunction.vlookup(pelanggan, rang, 8, false)
getharga = application.worksheetfunction.vlookup(range("D13") & range("E13"), lookharga, 4, false)
getharga1 = application.worksheetfunction.vlookup(range("D14") & range("E14"), lookharga, 4, false)
getharga2 = application.worksheetfunction.vlookup(range("D15") & range("E15"), lookharga, 4, false)
getharga3 = application.worksheetfunction.vlookup(range("D16") & range("E16"), lookharga, 4, false)
getharga4 = application.worksheetfunction.vlookup(range("D17") & range("E17"), lookharga, 4, false)
alamat.value = getalamat
jdiskon.value = jenisdiskon
diskon.value = getdiskon / 100
if jdiskon = "nett" then
range("M13").value = getharga - (getharga * diskon)
range("M14").value = getharga1 - (getharga1 * diskon)
range("M15").value = getharga2 - (getharga2 * diskon)
range("M16").value = getharga3 - (getharga3 * diskon)
range("M17").value = getharga4 - (getharga4 * diskon)
elseif jdiskon.value = "pot" then
range("M13").value = getharga
range("M14").value = getharga1
range("M15").value = getharga2
range("M16").value = getharga3
range("M17").value = getharga4
range("L25").value = diskon
end if
application.enableevents = true
end sub
Right now I'm just using the manual code by copy/pasting. However, I want to simplify the code within the IF by using loops because it seems to be more efficient.
What's the best way to do this?
Write your code like follow:
Dim book1 As Workbooks
Dim customer As Range, rang As Range, jdiskon As Range, pelanggan As Range, lookharga As Range, diskon As Range
Dim rout(1 To 10) As Variant, i As Long
Set book1 = Workbooks("database.xlsx")
Set rang = book1.Sheets("DB").Range("A6:N84")
Set lookharga = book1.Sheets("harga").Range("B4:E50")
Set pelanggan = Range("E7")
Set alamat = Range("E8")
Set jdiskon = Range("M26")
Set diskon = Range("P3")
getalamat = Application.WorksheetFunction.VLookup(pelanggan, rang, 13, False)
jenisdiskon = Application.WorksheetFunction.VLookup(pelanggan, rang, 10, False)
getdiskon = Application.WorksheetFunction.VLookup(pelanggan, rang, 8, False)
'New code with if statement starts from here
alamat.Value = getalamat
jdiskon.Value = jenisdiskon
diskon.Value = getdiskon / 100
For i = 13 To 17
getharga = Application.WorksheetFunction.VLookup(Range("D" & i) & Range("E" & i), lookharga, 4, False)
If jdiskon = "nett" Then
Range("M" & i).Value = getharga - (getharga * diskon)
ElseIf jdiskon.Value = "pot" Then
Range("M" & i).Value = getharga
Range("L25").Value = diskon
End If
' new code with if statement ends here
Next
Application.EnableEvents = True
End Sub
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