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.
Related
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.
Everyone!
I'm working on macros which should select cdrBitmapShape and save it as a separate file.
I've already found out how to search and select such an object, but I've run into a problem of saving it.
I don't get how should I save the chosen image, it is quite unclear from the docs.
As I understand from here I should somehow assign to the Document variable the current selection Item and export it.
Here is the test file
How can I do that?
Sub Findall_bit_map()
' Recorded 03.02.2020
'frmFileConverter.Start
'Dim d As Document
Dim retval As Long
Dim opt As New StructExportOptions
opt.AntiAliasingType = cdrNormalAntiAliasing
opt.ImageType = cdrRGBColorImage
opt.ResolutionX = 600
opt.ResolutionY = 600
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.NumColors = 16
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = Document.ExportBitmap("D:\some.jpg", cdrJPEG)
If Filter.ShowDialog() Then
Filter.Finish
Else
MsgBox "Export canceled"
End If
End If
Next shpCheck
retval = MsgBox("Click OK if you agree.", vbOKCancel, "Easy Message")
'ActivePage.Shapes.FindShapes(Query:="#type='BitmapShape'")
If retval = vbOK Then
MsgBox "You clicked OK.", vbOK, "Affirmative"
End If
End Sub
I don't know were was the bug, but here is the working version.
Sub Findall_bit_map_snip()
Dim retval As Long
Dim doc As Document
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.ColorSensitive = True
pal.NumColors = 300000000
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
Set doc = ActiveDocument
doc.ClearSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = doc.ExportBitmap("D:\some.jpg", cdrJPEG, cdrSelection, , , , 600, 600, cdrNoAntiAliasing, , False, , , , pal)
Filter.Finish
End If
Next shpCheck
End Sub
I am using a spin button to cycle through dates of a phase. When I call an item from a collection called customtextboxcollection with its index value, I get an "Object Required" error. Both the spin button and the text box whose value changes are dynamically created controls displayed on a UserForm called UserForm1.
The sub to create the items in customtextbox collection run before the spin button is clicked:
Dim customtextboxcollection As Collection
Dim spinbuttoncollection As Collection
Public Sub ComboBox1_Click() 'When a person is selected to enter hours for an employee from a combobox, it triggers the creation of the controls
Sheet1.Activate
CommandButton1.Enabled = True 'Enable the OK and Apply buttons when personnel title is selected.
UserForm1.Label2.Visible = True
UserForm1.ratebox.Visible = True
QuantityLabel.Visible = True
quantitybox.Visible = True
'The variables below are to access the table where I store saved information regarding the project phases I will add hours to.
Dim counter As Integer
counter = 6 'The index of the first row for phases
Dim phasecolumn As Integer
phasecolumn = 3 'The index of the column containing the phases
Dim checkboxnumber As Integer
checkboxnumber = 1 'This is the number needed to distinguish between the checkboxes that appear/disappear.
phasestartcolumn = 4
phaseendcolumn = 5
Dim customtextboxHandler As cCustomTextBoxHandler
Set customtextboxcollection = New Collection 'Sets the previously created collection
Dim spinbuttonHandler As cSpinButtonHandler 'This is my spin button handler class
Set spinbuttoncollection = New Collection 'Sets the previously created collection
'This Do-Loop locates a row on the table with saved information
Do
If (Sheet3.Cells(savedpersonnelrow, savedpersonnelcolumn) = ComboBox1.Value) Then
storagerow = savedpersonnelrow
lastcomboboxvalue = ComboBox1.Value
Exit Do
End If
savedpersonnelrow = savedpersonnelrow + 1
Loop Until (savedpersonnelrow = 82)
Sheet1.Activate
'These sections create the controls depending on the number of phases saved.
Set spin = UserForm1.Controls.Add("Forms.SpinButton.1")
With spin
.name = "SpinButton" & checkboxnumber
.Left = 365
.Top = topvalue + 6
.Height = 15
.Width = 40
'.Value = Sheet3.Cells(storagerow, savedphasecolumn + checkboxnumber)
'Sheet1.Activate
Dim phasestart As Date
phasestart = Sheet1.Cells(counter, phasestartcolumn).Value
Dim phaseend As Date
phaseend = Sheet1.Cells(counter, phaseendcolumn).Value
spin.Min = phasestart
spin.Max = phaseend
spin.Orientation = fmOrientationVertical
'Do
'.AddItem Format(phasestart, "mmm-yy")
'phasestart = DateAdd("m", 1, phasestart)
'Loop Until (Month(phaseend) = Month(phasestart) And Year(phaseend) = Year(phasestart))
Set spinbuttonHandler = New cSpinButtonHandler
Set spinbuttonHandler.spin = spin
spinbuttoncollection.Add spinbuttonHandler
End With
Set ctext = UserForm1.Controls.Add("Forms.TextBox.1")
With ctext
.name = "CustomTextbox" & checkboxnumber
.Left = 470
.Top = topvalue + 6
.Height = 15
.Width = 40
.Value = phasestart
Set customtextboxHandler = New cCustomTextBoxHandler
Set customtextboxHandler.ctext = ctext
customtextboxcollection.Add customtextboxHandler
End With
topvalue = topvalue + 15
counter = counter + 1
checkboxnumber = checkboxnumber + 1
Loop Until counter = 14
End Sub
In my class called cSpinButtonHandler, I reference these customtextboxcollection object associated with it's corresponding spin button:
Public WithEvents spin As MSForms.SpinButton
Private Sub spin_Click()
UserForm1.CommandButton3.Enabled = True
End Sub
Private Sub spin_SpinDown()
x = 0
Do
x = x + 1
Loop Until spin.name = "SpinButton" & x
Dim spindate As Date
spindate = customtextboxcollection.Item(x).ctext.Value 'The error occurs here.
customtextboxcollection.Item(x).ctext.Value = DateAdd("m", -1, spindate)
End Sub
Why is this reference generating an error? What is the correct way to reference it?
This is not an answer to your real question, but a suggestion for an alternate approach which might be easier to manage.
Instead of using two separate collections and two different classes, you could create a single class which would handle each pair of controls (one spin and one text box). That would be easier to handle in terms of hooking events between each pair.
clsSpinText:
Option Explicit
Public WithEvents txtbox As MSForms.TextBox
Public WithEvents spinbutn As MSForms.SpinButton
Private Sub spinbutn_Change()
'here you can refer directly to "txtbox"
End Sub
Private Sub txtbox_Change()
'here you can refer directly to "spinbutn"
End Sub
When adding your controls create one instance of clsSpinText per pair, and hold those instances in a single collection.
I am writing a vb.net code in Visual Studio for an add on in SAP B1. Right now, I want to choose an option button and according to what the user chose, I want to take this value and send it to another function in another class. This action I want to make it right after the user press the OK button, so I am trying to do this in an event.
The code that I wrote for creating the options buttons:
Dim optBtn As SAPbouiCOM.OptionBtn
'Dim oFrm As SAPbouiCOM.Form
Dim oUserdatasource As SAPbouiCOM.UserDataSource
oUserdatasource = oform2.DataSources.UserDataSources.Add("BD_resDS", SAPbouiCOM.BoDataType.dt_SHORT_TEXT, 1)
'Option 1
oItem = oform2.Items.Add("BD_rbRes", SAPbouiCOM.BoFormItemTypes.it_OPTION_BUTTON)
oItem.Left = 155
oItem.Top = 10
oItem.Height = 16
oItem.Width = 55
optBtn = oItem.Specific
optBtn.Caption = "Cheque"
optBtn.DataBind.SetBound(True, , "BD_resDS")
'Option 2
oItem = oform2.Items.Add("BD_rbPost", SAPbouiCOM.BoFormItemTypes.it_OPTION_BUTTON)
oItem.Left = 220
oItem.Top = 10
oItem.Height = 16
oItem.Width = 55
optBtn = oItem.Specific
optBtn.Caption = "Cash"
oItem.Visible = True
optBtn = oItem.Specific
optBtn.GroupWith("BD_rbRes")
optBtn.DataBind.SetBound(True, , "BD_resDS")
'Option 3
oItem = oform2.Items.Add("BD_rbPost2", SAPbouiCOM.BoFormItemTypes.it_OPTION_BUTTON)
oItem.Left = 280
oItem.Top = 10
oItem.Height = 16
oItem.Width = 75
optBtn = oItem.Specific
optBtn.Caption = "Credit Card"
oItem.Visible = True
optBtn = oItem.Specific
optBtn.GroupWith("BD_rbPost")
The code that I wrote in the event is this :
Public Sub SBO_Application_ItemEvent(ByVal FormUID As String, ByRef pVal As SAPbouiCOM.ItemEvent, ByRef BubbleEvent As Boolean) Handles SBO_Application.ItemEvent
Try
Dim fInv As SAPbouiCOM.Form
Dim omethod As SAPbouiCOM.Item
Dim opaymeth As SAPbouiCOM.OptionBtn
Dim paymeth As String
'If pVal.ItemUID = "1" And pVal.EventType = SAPbouiCOM.BoEventTypes.et_ITEM_PRESSED And pVal.BeforeAction = True And pVal.ActionSuccess = False And pVal.FormUID = "60006" Then
'End If
'Events of the Blanket Agreement form
If (FormUID = "Choose") Then
If (pVal.BeforeAction = False) Then
' Click on Add Row
If (pVal.ItemUID = "1") And (pVal.EventType = SAPbouiCOM.BoEventTypes.et_ITEM_PRESSED) Then
fInv = SBO_Application.Forms.Item(FormUID)
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
opaymeth = omethod.Specific
paymeth = opaymeth.Value.ToString()
SBO_Application.MessageBox(paymeth)
If paymeth <> "" And paymeth <> Nothing Then
Dim paym As New payment(SBO_Application, oCompany)
paym.pay(paymeth)
End If
End If
End If
End If
Catch ex As Exception
'SBO_Application.MessageBox(er.Message)
SBO_Application.MessageBox(ex.Message)
End Try
End Sub
Now, the error that I got in SAP B1 is:
Unable to cast object 'System.String' to type 'SAPbouiCOM.Item'
You have declared
Dim omethod As SAPbouiCOM.Item
and assigning it to the string value
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
Declare string variable and assign value to it like
Dim tmpval as string =""
tmpval = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
try this
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
.ValueEx seems to return a String, so I guess you just need to remove it
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS")
Another fine example why you should always turn Option Strict ON ;)
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