Print from SAP using access ?? Without having to open SAP - vba

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

Related

PowerPoint doesn't remove chart titles

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

Red X shown in VB.NET chart

I have code that calculates stress at multiple points on a tank and then graphs these stresses on a Chart. I'll be viewing charts with no problem, and all of a sudden, the chart displays a red X and I need to close my program to view the stress results again.
I know there's no bug in my code. No exception is thrown. Any suggestions?
Public Sub Graph(Curves) 'Creates the Graphs
crtStressData.Series.Clear()
crtStressData.Legends.Clear()
'Dimension arrays for data points
FileClose()
Dim data As Double
Dim StressTitle As String
Dim k As Integer
Dim BorderSize As Integer = 4
'set up main graph
crtStressData.ChartAreas(0).CursorX.IsUserSelectionEnabled = True
crtStressData.ChartAreas(0).CursorY.IsUserSelectionEnabled = True
crtStressData.ChartAreas(0).AxisX.ScaleView.Zoomable = True
crtStressData.ChartAreas(0).AxisY.ScaleView.Zoomable = True
crtStressData.ChartAreas(0).AxisX.ScrollBar.IsPositionedInside = False
crtStressData.ChartAreas(0).AxisY.ScrollBar.IsPositionedInside = False
Dim LegendName As String = ""
StressTitle = TankName + " " + GraphType + " Stresses: " + strLoad + " Loading"
If GraphType = "Combined" Then
'Set component parameters
'Create Combined Graph
Call CreateDataPoints()
'Add title,
crtStressData.Titles(0).Text = StressTitle
For i = 0 To Curves - 1 'add legends
If i = 0 Then
LegendName = "Minimum Principal Stress"
ElseIf i = 1 Then
LegendName = "Minimum Principal Stress Location"
ElseIf i = 2 Then
LegendName = "Maximum Principal Stress"
ElseIf i = 3 Then
LegendName = "Maximum Principal Stress Location"
End If
crtStressData.Series.Add(LegendName)
''work on legend name
crtStressData.Series(i).ChartType = DataVisualization.Charting.SeriesChartType.Line 'sets as a line graph
crtStressData.Series(i).XAxisType = DataVisualization.Charting.AxisType.Primary
crtStressData.Series(i).YAxisType = DataVisualization.Charting.AxisType.Primary
crtStressData.Series(i).BorderWidth = BorderSize
For j = 0 To MaxDataPoints 'add points per legend type
'set up which data to add and define color
If i = 0 Then
' StressType(k) = "Minimum Principal Stress"
data = SMINMAXData(j)
color = Drawing.Color.Blue
ElseIf i = 1 Then
' StressType(k) = "Minimum Principal Stress Location"
data = SMINLOCData(j)
color = Drawing.Color.Green
ElseIf i = 2 Then
'StressType(k) = "Maximum Principal Stress"
data = SMAXMAXData(j)
color = Drawing.Color.DodgerBlue
ElseIf i = 3 Then
' StressType(k) = "Minimum Principal Stress Location"
data = SMAXLOCData(j)
color = Drawing.Color.Red
End If
'add data and color
crtStressData.Series(i).Points.AddXY(XPosData(j), data)
crtStressData.Series(i).Color = color
Next
k = k + 1
Next
Else ' GraphType = "Components"
crtStressData.Series.Clear()
'Set component parameters
'Create Component Graph
Call CreateDataPoints()
'Add title and axes labels
crtStressData.Titles(0).Text = StressTitle
For i = 0 To Curves - 1 'add legends
If i = 0 Then
LegendName = "Bending"
ElseIf i = 1 Then
LegendName = "Pressure (X)"
ElseIf i = 2 Then
LegendName = "Tension (X)"
ElseIf i = 3 Then
LegendName = "Total (X)"
ElseIf i = 4 Then
LegendName = "Pressure (Y)"
ElseIf i = 5 Then
LegendName = "Shear"
End If
crtStressData.Series.Add(LegendName) 'creates line
crtStressData.Series(i).ChartType = DataVisualization.Charting.SeriesChartType.Line 'sets as a line graph
crtStressData.Series(i).XAxisType = DataVisualization.Charting.AxisType.Primary
crtStressData.Series(i).YAxisType = DataVisualization.Charting.AxisType.Primary
crtStressData.Series(i).BorderWidth = BorderSize
For j = 0 To MaxDataPoints 'add points per legend
If i = 0 Then
'StressType(k) = "Bending"
data = SXBMAXData(j)
color = Drawing.Color.Blue
ElseIf i = 1 Then
' StressType(k) = "Pressure (X)"
data = SXPMAXData(j)
color = Drawing.Color.Green
ElseIf i = 2 Then
' StressType(k) = "Tension (X)"
data = SXTMAXData(j)
color = Drawing.Color.DodgerBlue
ElseIf i = 3 Then
'StressType(k) = "Total (X)"
data = SXMAXData(j)
color = Drawing.Color.Red
ElseIf i = 4 Then
' StressType(k) = "Pressure (Y)"
data = SYMAXData(j)
color = Drawing.Color.HotPink
ElseIf i = 5 Then
' StressType(k) = "Shear"
data = SSMAXData(j)
color = Drawing.Color.DarkOrange
End If
'add data and color
crtStressData.Series(i).Points.AddXY(XPosData(j), data)
crtStressData.Series(i).Color = color
Next
k = k + 1
Next
End If
'LEGEND
Dim StressLegend As Legend = New Legend()
StressLegend.IsDockedInsideChartArea = False
StressLegend.Docking = Docking.Bottom
StressLegend.Font = New Font("Gil Sans MT", 11)
StressLegend.TextWrapThreshold = 100
StressLegend.Alignment = StringAlignment.Center
crtStressData.Legends.Add(StressLegend)
crtStressData.Dock = DockStyle.None
crtStressData.Show()
End Sub

Excel Stacked Area Chart Using VBA

I am trying to duplicate the results found in the following site: http://peltiertech.com/?s=variable+column
The only difference is that I would like to use VBA code only to accomplish the end result. I would like to avoid referencing any fields on a worksheet. The end result creates columns with variable widths. I have confirmed that the process described on the website works when using data on a worksheet. I just can’t make the transition to getting the same result with only using code.
Here is what I have so far:
Sub RangeTest()
Dim MyArray1(1 To 14) As Variant
Dim MyArray2(1 To 14) As Variant
Dim MyArray3(1 To 14) As Variant
Dim MyArray4(1 To 14) As Variant
Dim MyArray5(1 To 14) As Variant
MyArray1(1) = 0
MyArray1(2) = 0
MyArray1(3) = 12.5
MyArray1(4) = 25
MyArray1(5) = 25
MyArray1(6) = 50
MyArray1(7) = 75
MyArray1(8) = 75
MyArray1(9) = 112.5
MyArray1(10) = 150
MyArray1(11) = 150
MyArray1(12) = 200
MyArray1(13) = 250
MyArray1(14) = 250
MyArray2(1) = 0
MyArray2(2) = 100
MyArray2(3) = 100
MyArray2(4) = 100
MyArray2(5) = 0
MyArray2(6) = 0
MyArray2(7) = 0
MyArray2(8) = 0
MyArray2(9) = 0
MyArray2(10) = 0
MyArray2(11) = 0
MyArray2(12) = 0
MyArray2(13) = 0
MyArray2(14) = 0
MyArray3(1) = 0
MyArray3(2) = 0
MyArray3(3) = 0
MyArray3(4) = 0
MyArray3(5) = 75
MyArray3(6) = 75
MyArray3(7) = 75
MyArray3(8) = 0
MyArray3(9) = 0
MyArray3(10) = 0
MyArray3(11) = 0
MyArray3(12) = 0
MyArray3(13) = 0
MyArray3(14) = 0
MyArray4(1) = 0
MyArray4(2) = 0
MyArray4(3) = 0
MyArray4(4) = 0
MyArray4(5) = 0
MyArray4(6) = 0
MyArray4(7) = 0
MyArray4(8) = 50
MyArray4(9) = 50
MyArray4(10) = 50
MyArray4(11) = 0
MyArray4(12) = 0
MyArray4(13) = 0
MyArray4(14) = 0
MyArray5(1) = 0
MyArray5(2) = 0
MyArray5(3) = 0
MyArray5(4) = 0
MyArray5(5) = 0
MyArray5(6) = 0
MyArray5(7) = 0
MyArray5(8) = 0
MyArray5(9) = 0
MyArray5(10) = 0
MyArray5(11) = 25
MyArray5(12) = 25
MyArray5(13) = 25
MyArray5(14) = 0
ActiveSheet.ChartObjects.Add(Left:=10, Width:=900, Top:=265, Height:=245).Name = "Testing1"
ActiveSheet.ChartObjects("Testing1").Chart.ChartType = xlAreaStacked
ActiveSheet.ChartObjects("Testing1").Chart.Axes(xlCategory).CategoryType = xlTimeScale
With ActiveSheet.ChartObjects("Testing1").Chart
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = MyArray1
.SeriesCollection(1).Values = MyArray2
.SeriesCollection(1).Name = "Alpha"
.SeriesCollection.NewSeries
.SeriesCollection(2).XValues = MyArray1
.SeriesCollection(2).Values = MyArray3
.SeriesCollection(2).Name = "Beta"
.SeriesCollection.NewSeries
.SeriesCollection(3).XValues = MyArray1
.SeriesCollection(3).Values = MyArray4
.SeriesCollection(3).Name = "Gamma"
.SeriesCollection.NewSeries
.SeriesCollection(4).XValues = MyArray1
.SeriesCollection(4).Values = MyArray5
.SeriesCollection(4).Name = "Delta"
End With
End Sub
This creates the chart but does not make the conversion to variable column width.

You didn't say what went wrong.
I didn't change much of your code, just rearranged it to make it more readable and maybe more efficient.
Sub RangeTest()
Dim MyChart As ChartObject
Dim MyArray1(1 To 14) As Variant
Dim MyArray2(1 To 14) As Variant
Dim MyArray3(1 To 14) As Variant
Dim MyArray4(1 To 14) As Variant
Dim MyArray5(1 To 14) As Variant
MyArray1(1) = 0
MyArray1(2) = 0
MyArray1(3) = 12.5
MyArray1(4) = 25
MyArray1(5) = 25
MyArray1(6) = 50
MyArray1(7) = 75
MyArray1(8) = 75
MyArray1(9) = 112.5
MyArray1(10) = 150
MyArray1(11) = 150
MyArray1(12) = 200
MyArray1(13) = 250
MyArray1(14) = 250
MyArray2(1) = 0
MyArray2(2) = 100
MyArray2(3) = 100
MyArray2(4) = 100
MyArray2(5) = 0
MyArray2(6) = 0
MyArray2(7) = 0
MyArray2(8) = 0
MyArray2(9) = 0
MyArray2(10) = 0
MyArray2(11) = 0
MyArray2(12) = 0
MyArray2(13) = 0
MyArray2(14) = 0
MyArray3(1) = 0
MyArray3(2) = 0
MyArray3(3) = 0
MyArray3(4) = 0
MyArray3(5) = 75
MyArray3(6) = 75
MyArray3(7) = 75
MyArray3(8) = 0
MyArray3(9) = 0
MyArray3(10) = 0
MyArray3(11) = 0
MyArray3(12) = 0
MyArray3(13) = 0
MyArray3(14) = 0
MyArray4(1) = 0
MyArray4(2) = 0
MyArray4(3) = 0
MyArray4(4) = 0
MyArray4(5) = 0
MyArray4(6) = 0
MyArray4(7) = 0
MyArray4(8) = 50
MyArray4(9) = 50
MyArray4(10) = 50
MyArray4(11) = 0
MyArray4(12) = 0
MyArray4(13) = 0
MyArray4(14) = 0
MyArray5(1) = 0
MyArray5(2) = 0
MyArray5(3) = 0
MyArray5(4) = 0
MyArray5(5) = 0
MyArray5(6) = 0
MyArray5(7) = 0
MyArray5(8) = 0
MyArray5(9) = 0
MyArray5(10) = 0
MyArray5(11) = 25
MyArray5(12) = 25
MyArray5(13) = 25
MyArray5(14) = 0
Set MyChart = ActiveSheet.ChartObjects.Add(Left:=10, Width:=900, Top:=265, Height:=245)
With MyChart
.Name = "Testing1"
With .Chart
With .SeriesCollection.NewSeries
.XValues = MyArray1
.Values = MyArray2
.Name = "Alpha"
End With
With .SeriesCollection.NewSeries
.XValues = MyArray1
.Values = MyArray3
.Name = "Beta"
End With
With .SeriesCollection.NewSeries
.XValues = MyArray1
.Values = MyArray4
.Name = "Gamma"
End With
With .SeriesCollection.NewSeries
.XValues = MyArray1
.Values = MyArray5
.Name = "Delta"
End With
.ChartType = xlAreaStacked
With .Axes(xlCategory)
.CategoryType = xlTimeScale
.MajorUnitScale = xlDays
.MajorUnit = 50
End With
End With
End With
End Sub

How to add option buttons to group in Excel 2010 sheet using VBA?

I want to add many option button to an excel worksheet (not to a VBA-form) and want to group them by row. The result should look something like this:
Here is the code I'm using so far:
For d = 1 To 31
Set checkboxKrankCell = Range("H" + Trim(Str(d)))
Set checkboxUrlaubCell = Range("I" + Trim(Str(d)))
Set checkboxJazCell = Range("J" + Trim(Str(d)))
groupWidth = checkboxKrankCell.Width + checkboxUrlaubCell.Width + checkboxJazCell.Width
Set groupBoxOptionButtons = ActiveSheet.GroupBoxes.Add(checkboxKrankCell.Left - 1, checkboxKrankCell.Top - 2, groupWidth + 1, checkboxKrankCell.Height)
With groupBoxOptionButtons
.Name = "GroupBox_" + Trim(Str(d))
.Caption = ""
End With
Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
With checkboxKrank
.Caption = ""
End With
#1 checkboxKrank.GroupBox = groupBoxOptionButtons
Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
With checkboxUrlaub
.Caption = ""
End With
Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
With checkboxJaz
.Caption = ""
#2 .GroupBox = groupBoxOptionButtons
End With
Next d
I would expect to assign the option buttons to the group for the current row by setting the GroupBox property (see #1 or #2).
But both methods just gave me an error saying 'The object does not support the property or methode'.
Any help or hint is welcome ;-)
Based on the tip from snb I have modified my function like this:
Sub AddOptionButtons()
ActiveSheet.OptionButtons.Delete
For d = 1 To 31
Set checkboxKrankCell = Range("H" + Trim(Str(d + 4)))
Set checkboxUrlaubCell = Range("I" + Trim(Str(d + 4)))
Set checkboxJazCell = Range("J" + Trim(Str(d + 4)))
option1Name = "Krank_" + Trim(Str(d))
option2Name = "Urlaub_" + Trim(Str(d))
option3Name = "Jaz_" + Trim(Str(d))
Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
With checkboxKrank
.Caption = ""
.Name = option1Name
End With
Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
With checkboxUrlaub
.Caption = ""
.Name = option2Name
End With
Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
With checkboxJaz
.Caption = ""
.Name = option3Name
End With
ActiveSheet.Shapes.Range(Array(option1Name, option2Name, option3Name)).Group
Next d
End Sub
I don't get any errors using Shapes.Range(...).Group.
But still all option buttons from on the sheet are all mutual exclusive.
Seems grouping does not work here.

Try the following code on an empty workbook. It will give you an option to choose only ONE optionbutton on each row, which is what you want, as far as I understood (I also created a linked cell reference, just in case you would like to take further action, given the choice of a user.):
Sub AddOptionButtons()
Dim btn1 As OptionButton
Dim btn2 As OptionButton
Dim btn3 As OptionButton
Dim grbox As GroupBox
Dim t As Range
Dim s As Range
Dim p As Range
Dim i As Integer
ActiveSheet.OptionButtons.Delete
ActiveSheet.GroupBoxes.Delete
For i = 5 To 35 Step 1
Set t = ActiveSheet.Range(Cells(i, 8), Cells(i, 8))
Set s = ActiveSheet.Range(Cells(i, 9), Cells(i, 9))
Set p = ActiveSheet.Range(Cells(i, 10), Cells(i, 10))
Set btn1 = ActiveSheet.OptionButtons.Add(t.Left, t.Top, t.Width, t.Height)
Set btn2 = ActiveSheet.OptionButtons.Add(s.Left, s.Top, s.Width, s.Height)
Set btn3 = ActiveSheet.OptionButtons.Add(p.Left, p.Top, p.Width, p.Height)
Set grbox = ActiveSheet.GroupBoxes.Add(t.Left, t.Top, t.Width + 100, t.Height)
With btn1
.Caption = ""
.Display3DShading = True
.LinkedCell = "M" & i
End With
With btn2
.Caption = ""
.Display3DShading = True
End With
With btn3
.Caption = ""
.Display3DShading = True
End With
With grbox
.Caption = ""
.Visible = False
End With
Next i
End Sub

I'd use:
Sub M_snb()
ReDim sn(2)
For j = 1 To 2
For jj = 1 To 3
With Sheet1.OptionButtons.Add(Cells(j, jj).Left, Cells(j, jj).Top - 1, Cells(j, jj).Width, Cells(j, jj).Height)
sn(jj - 1) = .Name
End With
Next
Sheet1.Shapes.Range(sn).Group
Next
End Sub

VBA Error 438, PPT slide movement using values in Excel

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