Excel VBA array data source for Chartspace in Userform - vba

I try to generate a barchart within an Excel Userform - Chartspace Is there any possibility to use VBA generated array data as source for the bar chart. I can only find description for Spreadsheet as source.
Private Sub UserForm_Activate()
Dim z As Long, s As Integer
Dim cc
Dim ch1
Dim pt
For z = 1 To 9
For s = 1 To 2
Spreadsheet1.ActiveSheet.Cells(z, s) = Sheets("Tabelle1").Cells(z, s)
Next
Next
Set cc = ChartSpace1.Constants
Set ChartSpace1.DataSource = Spreadsheet1 '<-- does it need linked to a spreadsheet?
Set ch1 = ChartSpace1.Charts.Add
ch1.Type = cc.chChartTypeLineMarkers
ch1.SetData 1, 0, "A2:A9"
ch1.SeriesCollection(0).SetData 2, 0, "B2:B9"
End Sub
Is the a other way to show a bar chart in a userform where I can use the array source?
Thanks a lot.

Perhaps this suggests how to do it:
http://msdn.microsoft.com/en-us/library/office/aa193650(v=office.11).aspx
This example (slightly modified so that I could test from the link above) creates a chart using literal data arrays.
Output Example
Code Example
Sub BindChartToArrays()
Dim asSeriesNames(1)
Dim asCategories(7)
Dim aiValues(7)
Dim chConstants
Dim chtNewChart
Dim myChtSpace As ChartSpace
asSeriesNames(0) = "Satisfaction Data"
asCategories(0) = "Very Good"
asCategories(1) = "Good"
asCategories(2) = "N/A"
asCategories(3) = "Average"
asCategories(4) = "No Response"
asCategories(5) = "Poor"
asCategories(6) = "Very Poor"
aiValues(0) = 10
aiValues(1) = 22
aiValues(2) = 6
aiValues(3) = 31
aiValues(4) = 5
aiValues(5) = 14
aiValues(6) = 12
Set myChtSpace = UserForm1.ChartSpace1
Set chConstants = myChtSpace.Constants
' Add a new chart to Chartspace1.
Set chtNewChart = myChtSpace.Charts.Add
' Specify that the chart is a column chart.
chtNewChart.Type = chConstants.chChartTypeColumnClustered
' Bind the chart to the arrays.
chtNewChart.SetData chConstants.chDimSeriesNames, chConstants.chDataLiteral, asSeriesNames
chtNewChart.SetData chConstants.chDimCategories, chConstants.chDataLiteral, asCategories
chtNewChart.SeriesCollection(0).SetData chConstants.chDimValues, chConstants.chDataLiteral, aiValues
UserForm1.Show
End Sub

Related

How to Create mutiple Tables on word with VB.NET

Dim Linha3 = WordDoc.Paragraphs.Add
Dim Tabela = WordDoc.Tables.Add(Linha3.Range, 7, 5)
Tabela.Range.Font.Name = "Calibri"
Tabela.Range.Font.Size = 8
Tabela.Columns(2).Width = 50
Tabela.Columns(3).Width = 150
Tabela.Columns(4).Width = 80
Tabela.Columns(5).Width = 80
Tabela.Range.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphCenter
Tabela.Cell(1, 4).Merge(Tabela.Cell(1, 5))
My question is. I wanna do this on a loop, cuz I gotta create mutiple tables. The problem is, when the loop occours it gives me a error saying that like Columns(2) was alredy resized, and kind double it... So I was thinking I gotta create like "Tabela2" but how can I create a dynamic variable ?
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim objApp = New Word.Application
Dim objDoc As Word.Document
'For New Page = Word.WdBreakType.wdPageBreak
'For New section without a corresponding page break = Word.WdBreakType.wdSectionBreakContinuous
Dim objPageBreak As Object = Word.WdBreakType.wdSectionBreakContinuous
objApp = CreateObject("Word.Application")
objApp.Visible = True
objDoc = objApp.Documents.Add
For i = 1 To 3
CreateTableInWordDocument(objDoc.Bookmarks.Item("\endofdoc").Range, objDoc, objApp)
objDoc.Bookmarks.Item("\endofdoc").Range.InsertBreak(objPageBreak)
Next
End Sub
Private Sub CreateTableInWordDocument(objRange As Word.Range, objDoc As Word.Document, objApp As Word.Application)
Dim objTable As Word.Table
objTable = objRange.Tables.Add(objRange, 7, 5)
objTable.Borders.Enable = True
objTable.Borders.OutsideLineStyle = Word.WdLineStyle.wdLineStyleDouble
objTable.Borders.InsideLineStyle = Word.WdLineStyle.wdLineStyleSingle
Dim r As Integer, c As Integer
For r = 1 To 7
For c = 1 To 5
objTable.Cell(r, c).Range.Text = "Row" & r & " Column" & c
Next
Next
objTable.Rows.Item(1).Range.Font.Bold = True
objTable.Rows.Item(1).Range.Font.Italic = True
Me.Close()
End Sub
End Class
You must add one Button1 control in Windows desktop App and use this code - in loop For i=1 To 3 - here 3 is the count of tables to add in a Word document.
The thing on add more tables was. On my code, here:
Dim Tabela = WordDoc.Tables.Add(Linha3.Range, 7, 5)
The "WordDoc.Paragraphs.Add" wasnt the same I was using on the WordDoc. I was using "Linha" for the rest of the document instead of Linha3. Idk why it make diference, but that is what was giving me error.
So I just change it to "Linha", and it worked fine, with some custom editing to the Text of some cells.
Dim WordDoc = WordApp.Documents.Add
Dim Linha = WordDoc.Paragraphs.Add
The answer is just dont add another WordDoc.Paragraphs, And u should be fine.

How to make a foreach button in vba that saves values for an array of textboxes?

I have an List in a different form , and the values that are located inside the text boxes are retrieved from a list in a different form , my problem is that i cannot delete the values all at once because they come from a view and i'm not allowed to change multiple tables all at once, so my solution is to create an array with all my text boxes and to turn the value to null 1 by 1 and save them individual so that i don't get that error.
I've tried different solutions like saving everything at once.
Private Sub Comando28_Click()
Dim strTextBoxes(1 To 5) As String
tbAplic = Me.TbUAplicacion.Value
tbUsr = Me.tbuUsuario.Value
tbMail = Me.tbuMailUsuario.Value
tbnmbre = Me.tbuNombrePersona.Value
tbAppld = Me.tbuApellidosPersona.Value
tbDni = Me.tbuDNIPersona.Value
Dim ITM As strTextBoxes.ITM
For Each ITM In strTextBoxes.ITM
If ITM = Not Null Then ITM = Null
Guardar_Click '<---- this is a macro which I use to save the items new value
Next ITM
End Sub
the error it gives me when pressing the button that should make the action is as follows:
the user-defined type has not been defined
Try this:
Private Sub Comando28_Click()
Dim strTextBoxes(1 To 5) As String
tbAplic = Me.TbUAplicacion.Value
tbUsr = Me.tbuUsuario.Value
tbMail = Me.tbuMailUsuario.Value
tbnmbre = Me.tbuNombrePersona.Value
tbAppld = Me.tbuApellidosPersona.Value
tbDni = Me.tbuDNIPersona.Value
Dim ITM As String
Dim Item As Long
For Item = LBound(strTextBoxes) To UBound(strTextBoxes)
ITM = strTextBoxes(Item)
If ITM <> "" Then ITM = ""
Guardar_Click '<---- this is a macro which I use to save the items new value
Next
End Sub

OpenOffice BASIC how to insert checkbox in sheet

I'm using OpenOffice Calc.
And I am writing macro's in OpenOffice BASIC.
I need the right code to insert a checkbox in the sheet.
I now have
Dim Doc as Object
Doc = ThisComponent
Dim cbName As Object
cbName = "checkbox_name"
Dim oCheckBoxModel as Object
// dlg is a dialog, (don't know how to create a checkbox else)
oCheckBoxModel = dlg.getmodel().createInstance( "com.sun.star.awt.UnoControlCheckBoxModel" )
oCheckBoxModel.PositionX = 100
oCheckBoxModel.PositionY = 100
oCheckBoxModel.Width = 50
oCheckBoxModel.Height = 30
oCheckBoxModel.Label = id
oCheckBoxModel.Name = cbName
oCheckBoxModel.Enabled = True
oCheckBoxModel.TabIndex = 1
Doc.Sheets().insertByName( cbName, oCheckBoxModel ) // This line is totally wrong, but I hope it's clear what I want to do
So I want to create a checkbox, and then insert it into the sheet. (In a specific cell, or just by setting a X and Y position).
I searched on the internet, but I only find information about inserting controls into a dialog, not into a sheet
To create check boxes manually, see here. To create check boxes dynamically:
Sub CreateCheckbox
oDoc = ThisComponent
oSheet = oDoc.Sheets.getByIndex(0)
oDrawPage = oSheet.DrawPage 'Was oDrawPage = oDoc.getDrawPage()
oCheckboxModel = AddNewCheckbox("Checkbox_1", "Check this box", oDoc, oDrawPage)
End Sub
Function AddNewCheckbox(sName As String, sLabel As String, _
oDoc As Object, oDrawPage As Object) As Object
oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
aPoint = CreateUnoStruct("com.sun.star.awt.Point")
aSize = CreateUnoStruct("com.sun.star.awt.Size")
aPoint.X = 1000
aPoint.Y = 1000
aSize.Width = 3000
aSize.Height = 1000
oControlShape.setPosition(aPoint)
oControlShape.setSize(aSize)
oButtonModel = CreateUnoService("com.sun.star.form.component.CheckBox")
oButtonModel.Name = sName
oButtonModel.Label = sLabel
oControlShape.setControl(oButtonModel)
oDrawPage.add(oControlShape)
AddNewCheckbox = oButtonModel
End Function
This code was adapted from https://forum.openoffice.org/en/forum/viewtopic.php?f=45&t=46391.

Query relating to use of Offset - VBA

I wrote a code for the command button which copies particular data from a particular cell of sheet 1 and pastes in particular cell of sheet 2.
Next time i run the code i want the values to be placed in the next row that i used earlier in sheet 2
What is that i have to change in the code to get it so
Private Sub CommandButton1_Click()
text = Sheets(1).Range("B15")
Sheets(2).Range("B2").Value = Left(text, 4)
Sheets(2).Range("E2").Value = Right(text, 20)
text = Sheets(1).Range("C15")
Sheets(2).Range("C2").Value = text
text = Sheets(1).Range("B10")
Sheets(2).Range("G2").Value = text
text = Sheets(1).Range("B27")
Sheets(2).Range("H2").Value = text
text = Sheets(1).Range("B11")
Sheets(2).Range("J2").Value = text
text = Sheets(1).Range("B20")
Sheets(2).Range("K2").Value = text
text = Sheets(1).Range("D9")
Sheets(2).Range("L2").Value = text
End Sub
Private Sub CommandButton1_Click()
Dim c as Range
'assuming each row on sheet2 has a value in columnB...
Set c = Sheets(2).Cells(Rows.Count,"B").End(xlUp).Offset(1,0)
With c.EntireRow
text = Sheets(1).Range("B15")
.Cells(1,"B").Value = Left(text, 4)
.Cells(1,"E").Value = Right(text, 20)
.Cells(1,"C").Value = Sheets(1).Range("C15").Value
.Cells(1,"G").Value = Sheets(1).Range("B10").Value
.Cells(1,"H").Value = Sheets(1).Range("B27").Value
.Cells(1,"J").Value = Sheets(1).Range("B11").Value
.Cells(1,"K").Value = Sheets(1).Range("B20").Value
.Cells(1,"L").Value = Sheets(1).Range("D9").Value
End With
End Sub

Different errors like statement out of block, variable error showing in my macro

I am new to coding. I was trying to make a macro which searches through the charts in a sheet , searches if the chart has any data of Pfizer and then changing them in the chart to blue. So here, I am trying to search if datalabel has Pfizer and then changing the text to blue.
I tried using this code but did not work:-
Public Sub chartFormatting()
Dim CTRYname As String
Dim p As Integer
ivalue As String
Dim l As Integer
Dim rownum As Integer
For p = 1 To 13
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(p, 0).Value
rownum = wkbCurr.Sheets(CTRYname).Range("AA25").End(xlDown).Row
For s = 1 To rownum
ivalue = wkbCurr.Sheets(CTRYname).Charts(1).SeriesCollection(1).Points(s).DataLabel.Text
If InStr(ivalue, "Pfizer") <> 0 Then
With ivalue
With .Font
.Color = -65536
.TintAndShade = 0
End With
End With
wkbCurr.Sheets(CTRYname).Charts(1).SeriesCollection(1).Points(s).DataLabel.Text = ivalue
End If
Next s
Next p
End Sub
The variables have been declared else where too.
Now it is showing me a lot of errors. Please help and suggest a better way of formatting the text and lines in charts.
My main challenge is to format them only if Pfizer is there.
The root of your issue here is navigating the Chart object hierarchy. I find a good way to figure it out is the use the macro recorder to record the action you want to code (colour a label in this case) abd examine to objects recorded. You just need to ignore all the Select malarkey thae the recorder does and get to the core of the objects recorded.
I used this technique to refactor your code. I also use intermediate objects(sh, chrt and dl in this case) to help break down the object model:
Public Sub chartFormatting()
Dim CTRYname As String
Dim p As Integer
Dim ivalue As String
Dim l As Integer
Dim rownum As Integer
Dim s As Long
Dim dl As DataLabel
Dim chrt As Chart
Dim sh As Worksheet
For p = 1 To 13
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(p, 0).Value
Set sh = wkbCurr.Worksheets(CTRYname)
rownum = sh.Range("AA25").End(xlDown).Row
Set chrt = sh.ChartObjects(1).Chart
For s = 1 To rownum
With sh.ChartObjects(1).Chart.SeriesCollection(1).Points(s).DataLabel
If InStr(.Text, "Pfizer") <> 0 Then
With .Format.TextFrame2.TextRange.Font.Fill.ForeColor
.SchemeColor = 4
.TintAndShade = 0
End With
End If
End With
Next s
Next p
End Sub