I have the following macro in a Calc file:
Dim oDoc as Object
oDoc=ThisComponent
Dim oSheets as Object
oSheets = oDoc.Sheets
Dim oController as Object
oController = oDoc.getCurrentController()
Dim numVisibleSheet
numVisibleSheet = oController.VisibleRange.Sheet
Dim currentSheet as Object
currentSheet = oController.ActiveSheet
currentSheet = oSheets.getByIndex(numVisibleSheet)
MsgBox "ok"
cell = currentSheet.getCellByPosition(5000, 5)
cell.setString("toto")
When I run it on LibreOffice 7, I get an 'outOfBoundsException' in cellsuno.cxx.
Is my use of getCellByPosition bad? Are there bounds on the x and y coordinates for a cell, and if so how can I expand these bounds?
Thanks!
Related
To update pivot tables I use uno with this instruction:
dispatcher.executeDispatch(monDocUno, ".uno:RecalcPivotTable", "", 0, Array())
I would like not to use uno but the basic and its API to recalculate the pivot table of a calc sheet.
How we do that?
Just use the .refresh() method:
Sub refreshAllPilotTables
Dim oSheets As Variant
Dim oSheet As Variant
Dim oDataPilotTables As Variant
Dim oPilotTable As Variant
Dim i As Long
Dim j As Long
oSheets = ThisComponent.getSheets()
For i = 0 To oSheets.getCount()-1
oSheet = oSheets.getByIndex(i)
oDataPilotTables = oSheet.getDataPilotTables()
For j = 0 To oDataPilotTables.getCount()-1
oPilotTable = oDataPilotTables.getByIndex(j)
oPilotTable.refresh()
Next j
Next i
End Sub
I wrote a macro in Visio to retrieve the value for the shape property field index, but the row value keeps changing from shape to shape (sometimes 5 and sometimes 8). However, I can't find a way to replace the value 5 in CellsSRC with a solution that focuses on the row name rather than the row value. Any suggestions how I can find the value for the property "Index"?
This is my macro:
Sub Select_Shape()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoLayers As Visio.Layers
Set vsoPage = ActivePage
Set vsoLayers = vsoPage.Layers
ShapeID = ActiveWindow.Selection.PrimaryItem.ID 'find shape ID
Set vsoShape2 = Application.ActiveWindow.Page.Shapes.ItemFromID(ShapeID)
index_num = vsoShape2.CellsSRC(visSectionProp, 5, visCustPropsValue).FormulaU 'retrieve index value <-- Here is the issue
End Sub
This is the value I am looking for:
Many thanks for any suggestions!
I ended up solving the issue by calling the value of the cell, which is called "Prop._VisDM_Index", directly:
Sub Select_Shape()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoLayers As Visio.Layers
Dim cel As Visio.Cell
Set vsoPage = ActivePage
Set vsoLayers = vsoPage.Layers
ShapeID = ActiveWindow.Selection.PrimaryItem.ID
Set vsoShape2 = Application.ActiveWindow.Page.Shapes.ItemFromID(ShapeID)
Call Deselect_layers
shape_value = vsoShape2.Cells("Prop._VisDM_Index").FormulaU
vsoLayers.Item(shape_value).CellsC(visLayerVisible).FormulaU = "1"
End Sub
I would like to get some VBA code which would tell me the number of sheets in a Catia drawing. Each sheet would have a title block placed on it. A text field on each title block would communicates the number of sheets. So if you had three sheets in the drawing you would have 1 of 3 (in the title block sheet 1) 2 of 3 (in the title block shhet 2) and 3 of 3 (in the title block sheet 3). If the macro could update all title blocks on all sheets automatically.
Any help much appreciated.
The concept is to loop through all of the DrawingSheet objects in the Sheets collection of the DrawingDocument you should put all title block elements in the "Background View". Next we need to update or create existing title block text elements. These are DrawingText objects. We try to access the DrawingText by name(THIS MUST BE UNIQUE!). If it does not exist, we create it. If it does exist, we update the value.
Here's a start to making your title block:
Option Explicit
Sub UpdateSheetPage()
Dim DrawingDoc As DrawingDocument
Dim DSheet As DrawingSheet
Dim DView As DrawingView
Dim SheetCount As Integer
Dim currentSheet As Integer
'the drawing must be the active docuement window or this will fail. you can do more error checking if needed
On Error GoTo ExitSub
Set DrawingDoc = CATIA.ActiveDocument
SheetCount = DrawingDoc.Sheets.Count
currentSheet = 1 'initialize sheet number
'loop through all sheets and update or create a sheet number
For Each DSheet In DrawingDoc.Sheets
UpdatePageNumber DSheet, currentSheet, SheetCount
currentSheet = currentSheet + 1
Next
ExitSub:
End Sub
Sub UpdatePageNumber(currentDrawingSheet As DrawingSheet, currentSheetNumber As Integer, totalSheets As Integer)
Dim sheetNumber As String
Dim xPos, yPos As Long 'mm
'edit these if needed
xPos = 100 'edit this - only use for new creation
yPos = 100 'edit this
'display format
sheetNumber = "Page " & currentSheetNumber & "/" & totalSheets
Dim backgroundView As DrawingView
Dim dTexts As DrawingTexts
Dim currentText As DrawingText
Set backgroundView = currentDrawingSheet.Views.Item("Background View")
Set dTexts = backgroundView.Texts
On Error GoTo CreateNew
Set currentText = dTexts.GetItem("SheetNumber")
currentText.Text = sheetNumber
Exit Sub
CreateNew:
Set currentText = dTexts.Add(sheetNumber, xPos, yPos)
currentText.Name = "SheetNumber" 'so we can access it later for an update
End Sub
I am trying to create a VB macro in Visio that can read the data and properties of the shape. So say I have a Rectangle Shpae in Visio with Cells Name, Description, Type, Size.... and so on.
When I try to read the cells and their values I am only getting the first cell and its value.
Here is my code . I would appreciate some help here.
Sub Testing()
Dim excelObj As Object
Dim excelFile As String
Dim sheetName As String
' Dim excelBook As Excel.Workbook
' Set excelFile = "C:\Users\hbhasin\Documents\test.xls"
'Set sheetName = "New Sheet name"
Set excelObj = CreateObject("Excel.Application")
excelObj.Workbooks.Add
Dim pagObj As Visio.Page
Dim shpsObj As Visio.shapes
Dim shapes As Visio.shapes
Dim shpObj As Visio.Shape
Dim CellObj As Visio.Cell
Dim Storage() As String
Dim iShapeCount As Integer
Dim i As Integer
Dim j As Integer
Set pagObj = ActivePage
Set shpsObj = pagObj.shapes
iShapeCount = shpsObj.Count
Debug.Print iShapeCount
ReDim Storage(8, iShapeCount - 1)
For i = 1 To iShapeCount - 1
Set shpObj = shpsObj(i)
Storage(1, i - 1) = shpObj.Name
If shpObj.CellExists("Prop.Name", visExistsLocally) Then
Set CellObj = shpObj.CellsU("Prop.Name")
Storage(2, i - 1) = CellObj.ResultStr("")
End If
If shpObj.CellExists("Prop.Description", visExistsLocally) Then
Debug.Print "Test the IF statement"
Set CellObj = shpObj.CellsU("Prop.Description")
Storage(3, i - 1) = CellObj.ResultStr("")
End If
Next
For i = 0 To iShapeCount - 1
Debug.Print "Name- " & Storage(0, i)
Debug.Print "Description-" & Storage(1, i)
Next
End Sub
In fact, I have put a debug statement within the second if clause and that does not execute which tells me the compiler is not even seeing the second cell or any cell after.
If you're not getting the Description Shape Data it maybe that it's not local, but inherited from its master. Here's a slight modification of your code (with the Excel part removed as I don't think it's relevant here):
Sub Testing()
Dim shpsObj As Visio.shapes
Set shpsObj = ActivePage.shapes
Dim iShapeCount As Integer
iShapeCount = shpsObj.Count
'Assumes you want an array of shape data
Dim Storage() As String
ReDim Storage(iShapeCount - 1, 2)
'Visio shapes are 1 based so use full count
Dim i As Integer
Dim shpObj As Visio.Shape
For i = 1 To iShapeCount
Set shpObj = shpsObj(i)
Storage(i - 1, 0) = shpObj.Name 'Do you want NameU?
'Assumes you don't care whether the cell is local or inherited
If shpObj.CellExistsU("Prop.Name", visExistsAnywhere) Then
Storage(i - 1, 1) = shpObj.CellsU("Prop.Name").ResultStr("")
End If
If shpObj.CellExistsU("Prop.Description", visExistsAnywhere) Then
Storage(i - 1, 2) = shpObj.CellsU("Prop.Description").ResultStr("")
End If
Next
Dim j As Long
For j = LBound(Storage, 1) To UBound(Storage, 1)
Debug.Print "Shape Name- " & Storage(j, 0)
Debug.Print " Prop.Name- " & Storage(j, 1)
Debug.Print " Prop.Description- " & Storage(j, 2)
Next j
End Sub
If you're just running through all the shapes on the page, then you might want to look at For Each shp In shapes as an alternative. Check out this page for more details:
http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html
Also, you might want to try look at the CreateSelection page method to narrow down your target shapes if you're dealing with a large number
I'm creating a MACRO in MS Word that needs to be able to (basically) copy and paste the contents of a table in word into excel.
DISCLAIMER: This might seem like an over complication; however, the approach is required as it is a setup for more complicated processing.
Long story short, I loop through every table in the document, and then every cell in the table and place the text into a corresponding cell in an excel sheet.
I have these declarations for excel objects:
'Objects
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlRange As Excel.Range
At the bottom of my loops, I have the following code:
xlBook.Worksheets(x).Activate
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
xlRange.Text = tString
The last line is throwing an "object required" error. The variable tstring is defined as a string and is set earlier in the loop.
The full code:
Sub CopyTablesToExcel()
'Constants
Const COLUMN_INDEX = 1
Const ROW_INDEX = 2
'Ints
Dim x As Integer, y As Integer, z As Integer 'Counters
Dim numTables As Integer 'Number of tables in the word file
Dim numSheets As Integer 'Number of sheets in the excel file
Dim LastCell(1 To 2) As Integer 'Used to keep track of the last cell of a newly created excel table
Dim map() As Integer 'Holds a map of the table columns
'strings
Dim xlBookName As String 'Name of the excel workbook
Dim tString As String 'Temporary string
'Objects
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlRange As Excel.Range
'Initialize
Set xlBook = xlApp.Workbooks.Add
numSheets = xlBook.Worksheets.count
numTables = ActiveDocument.Tables.count
'Save the new book
xlBookName = InputBox("Enter the ticker symbol:")
xlBook.SaveAs FileName:=xlBookName
'Show the file?
xlApp.Visible = True
'Make sure there are enough sheets
If numSheets < numTables Then
For x = 1 To (numTables - numSheets)
xlBook.Worksheets.Add
numSheets = numSheets + 1
Next
End If
'Cycle through every table in the document and paste it to the worksheet
For z = 1 To numTables 'Cycle through tables
'Keep track of the last cell in the table
LastCell(COLUMN_INDEX) = ActiveDocument.Tables(z).Columns.count
LastCell(ROW_INDEX) = ActiveDocument.Tables(z).rows.count
For x = ActiveDocument.Tables(z).rows(ActiveDocument.Tables(z).rows.count).Cells.count To 1 Step -1 'Cycle through columns
'Used selections to support horizontally merged cells
ActiveDocument.Tables(z).rows(ActiveDocument.Tables(z).rows.count).Cells(x).Select
Selection.SelectColumn
For y = Selection.Cells.count To 1 Step -1 'Cycle through cells
tString = Selection.Cells(y).Range.Text
'Move the content into excel
xlBook.Worksheets(x).Activate
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
Debug.Print Chr(65 + x) & y 'Prints as expected
xlRange.Text = tString
Next
Next
Next
End Sub
I believe this is happening because the MACRO is failing to set the xlRange correctly. The output from debug.print is correct and is the format of "A#".
EDIT:
If Not xlRange Is Nothing Then
xlRange.Text = tString 'Still errors
End If
The above will evaluate to true but still throws the error at the marked line
I see two things:
.Text is a read only property. I would expect an an "Unable to set the text property of range object" error on this line:
xlRange.Text = tString
Change to:
xlRange.Value = tString
Also, your range assignment is probably wrong. I don't know why you are doing CHR(65) instead of simply "A", but the problem is this line:
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
Here you are ADDING x to 65, and then the Chr function returns whatever result that is, which could raise an error. A value of x that is greater than 25 will most likely raise an error becasue then Chr(65 + x) does not evaluate to a valid range address.
Since you clarify in the comments that you do intend to do this (e.g., "A" + 1 = "B", etc.), it would be better probably to do this, if for no other reason than it seems more legible and leverages the Excel object model in a less-ambiguous manner:
Set xlRange = xlBook.ActiveSheet.Range("A" & y).Offset(,x)