I am trying to make a layer in Visio visible through an Excel Macro, that I wrote. However, I always an invalid parameter error.
This is my code:
Sub visio_change_shape(index_value As Variant)
Dim AppVisio As Object
Dim VisioSystems As Object
Set AppVisio = GetObject(, "Visio.Application")
AppVisio.Pages(1).Layers.Item(index_value).CellsC(visLayerVisible).FormulaU = "1"
End Sub
However, in visio the same line works:
Private Sub Select_layers()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoLayers As Visio.Layers
Dim vsoLayer As Visio.Layer
Set vsoPage = ActivePage
Set vsoLayers = vsoPage.Layers
vsoLayer.CellsC(visLayerVisible).FormulaU = "1"
Next
End Sub
Thanks for any leads!
All you actually need is:
ActiveDocument.Pages(1).Layers.Item(index_value).CellsC(visLayerVisible).Formula = "1"
index_value should be a short int.
Related
I am writing a macro in CATIA v5 using VBA. The program is suppose to take points from a geometric set and transfer them into an excel file. I have successfully gotten the excel document open, a header created, but then I receive "Run-time error '438': Object doesn't support this property or method.
I have tried searching around and it seems like the section of code is trying to interact with something outside of its domain, but I cannot figure out how. Below is a sample of my code. The line that contains "***" to the left is the line that is being pointed out in the debugger.
Dim xls As Object
Dim wkbks As Object
Dim wkbk As Object
Dim wksheets As Object
Dim sheet As Object
Dim fs, f, f1, fc, s
Dim coords(2) As Integer
Dim PartDoc
Sub CATMain()
CATIA.ActiveDocument.Selection.Search "CATGmoSearch.Point,all"
'Function Calls
AppStart
CATIAtoXLS
'wksheet.Application.ActiveWorkbook.SaveAs (ExcelFolder & Left(CATIA.ActiveDocument.Name,Len(CATIA.ActiveDocument.Name)-8)&".xls")
'wksheet.Application.ActiveWorkbook.Close
End Sub
Private Sub AppStart()
Err.Clear
On Error Resume Next
Set xls = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set xls = CreateObject("Excel.Application")
End If
xls.Application.Visible = True
Set wkbks = xls.Application.Workbooks
Set wkbk = wkbks.Add
Set wksheets = wkbk.Worksheets(1)
Set sheet = wkbk.Sheets(1)
sheet.Cells(1, "A") = "X-Cord"
sheet.Cells(1, "B") = "Y-Cord"
sheet.Cells(1, "C") = "Z-Cord"
End Sub
Private Sub CATIAtoXLS()
For i = 1 To CATIA.ActiveDocument.Selection.Count
Set Selection = CATIA.ActiveDocument.Selection ***
Set Element = Selection.Item(i)
'Transfer data to xls
Point.GetCoordinates (coords)
sheet.Cells(i + 1, "A") = coords(0)
sheet.Cells(i + 1, "B") = coords(1)
sheet.Cells(i + 1, "C") = coords(2)
Next i
End Sub
Your first issue is that in any method in CATIA VBA which passes an array as an argument, must be called on a object declared variant (explicitly or by default).
So you it should look like this:
Dim px as Variant
Set px = CATIA.ActiveDocument.Selection.Item(i).Value
Call Point.GetCoordinates(coords)
The second problem is that in VBA if you use a subroutine with parentheses, you must use the Call keyword:
Call Point.GetCoordinates (coords)
Otherwise, you can skip the parentheses and the keyword:
Point.GetCoordinates coords
I need, for some reason, the category names of my chart. Here's what I got so far:
xlWorkbook = xlApp.ActiveWorkbook
Dim wsnat As Excel.Chart = TryCast(xlWorkbook.ActiveChart, Excel.Chart)
If Not wsnat Is Nothing Then
Dim axxxis As Excel.Axis = DirectCast(wsnat.Axes(Excel.XlAxisType.xlCategory, Excel.XlAxisGroup.xlPrimary), Excel.Axis)
Dim areyoukiddingme As Object = axxxis.CategoryNames
Dim arr As Array = DirectCast(areyoukiddingme, Array)
For q As Integer = 0 To arr.GetUpperBound(0)
Debug.Print(arr(q).ToString) ' HERE, the array 'arr' has two things which are EMPTY!
Next
End If
My problem is, that the array (arry) has the correct amount of EMPTY objects. If I do the whole thing in VBA, it works as expected. But it does not for VB.net. Any clues?
Here's the code in VBA:
Sub test()
Dim chrt As Chart
Set chrt = ActiveChart
Dim names As Variant
names = chrt.Axes(xlCategory, xlPrimary).CategoryNames
End Sub
This sub nicely outputs the category names of my chart!
I would like to count the lines that have values. I tried oSheet.Rows.Count but that doesn't work. Any idea about this?
My code is the following:
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets("Sheet")
oSheet.Range("A" & max).Value = "0000111"
oSheet.Range("B1").Value ="Name"
oBook.SaveAs("C:\New folder\excel\" & datenw & ".xlsx")
oExcel.Quit()
As said in the comments, the following code should get you the count of rows that have values based on your Range:
Dim rowCount As Integer = oSheet.UsedRange.Rows.Count()
There is however a slight issue with your code I believe. This probably won't work:
oSheet = oBook.Worksheets("Sheet")
The reason it won't, is because "Sheet" doesn't exist on a new Workbook. "Sheet1" does, so this needs to be changed to:
oSheet = oBook.Worksheets("Sheet1")
'or
oSheet = oBook.Worksheets(1) 'remember Excel collections are one based not zero based
Lastly I would look at the way you are closing Excel as oExcel.Quit() is probably leaving an instance of Excel running. Have a look at this answer which links to Siddharth Rout's bit of code:
Private Sub ReleaseObject(ByVal obj As Object)
Try
Dim intRel As Integer = 0
Do
intRel = System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
Loop While intRel > 0
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
You also to make sure you release in the right order and release everything. This is usually in backwards order:
ReleaseObject(oSheet)
oBook.Close()
ReleaseObject(oBook)
oExcel.Quit()
ReleaseObject(oExcel)
However with all that said I would look at using the Microsoft.Office.Interop.Excel namespace directly rather than declaring objects:
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim oExcel As New Excel.Application
Dim oWorkbooks As Excel.Workbooks = oExcel.Workbooks
Dim oWorkbook As Excel.Workbook = oWorkbooks.Add()
Dim oSheets As Excel.Sheets = CType(oWorkbook.Sheets, Excel.Sheets)
Dim oWorksheet As Excel.Worksheet = CType(oSheets(1), Excel.Worksheet)
Dim oARange As Excel.Range = oWorksheet.Range("A" & max.ToString()) 'Not sure what max is but I took the assumption it's an Integer
oARange.Value = "0000111"
Dim oBRange As Excel.Range = oWorksheet.Range("B1")
oBRange.Value = "Name"
Dim oUsedRange As Excel.Range = oWorksheet.UsedRange()
Dim rowCount As Integer = oUsedRange.Rows.Count()
oWorkbook.SaveAs("C:\Test.xlsx")
ReleaseObject(oUsedRange)
ReleaseObject(oBRange)
ReleaseObject(oARange)
ReleaseObject(oWorksheet)
ReleaseObject(oSheets)
oWorkbook.Close()
ReleaseObject(oWorkbook)
ReleaseObject(oWorkbooks)
oExcel.Quit()
ReleaseObject(oExcel)
End Sub
Private Sub ReleaseObject(ByVal obj As Object)
Try
Dim intRel As Integer = 0
Do
intRel = System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
Loop While intRel > 0
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
I would also then look at turning Option Strict On:
Restricts implicit data type conversions to only widening conversions, disallows late binding, and disallows implicit typing that results in an Object type.
Define a row variable as Long, then start a loop which will end when it finds a blank value in column A:
Dim lRow as Long = 1
Do until oSheet.Range("A" & lRow).Value=""
' increment the loop variable
lRow+=1
Loop
' display the result in a message block
MsgBox(lRow-1)
I've been working with the code below and can't seem to figure out what's causing PowerPoint to crash on the last line. I've used the same block of code in other subs without issue. I suspect this may somehow be related to the onslideshowpagechange function.
The code runs through the VBA editor in PowerPoint with the following libraries.
Reference Libraries
I essentially want the code to execute when a slide change occurs in presentation mode. The part of the code that causes the crash I want to add a slide back in.
Thanks ahead of time for any help!
Public Function GetLayout( _
LayoutName As String, _
Optional ParentPresentation As Presentation = Nothing) As CustomLayout
If ParentPresentation Is Nothing Then
Set ParentPresentation = ActivePresentation
End If
Dim oLayout As CustomLayout
For Each oLayout In ParentPresentation.SlideMaster.CustomLayouts
If oLayout.Name = LayoutName Then
Set GetLayout = oLayout
Exit For
End If
Next
End Function
Sub onslideshowpagechange(ByVal SSW As SlideShowWindow)
Dim oXL As Object 'Excel.Application
Dim oWb As Object 'Excel.Workbook
Dim oSld As Slide
' Check excel workbook file status, if not open then open
Dim file_status
file_status = IsWorkBookOpen("C:\Users\schuec1\Desktop\Peoria 2017 Media\Live Analysis\Live_Analysis.xlsx")
If file_status = False Then
Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Open(FileName:="C:\Users\schuec1\Desktop\Peoria 2017 Media\Live Analysis\Live_Analysis")
Else
Set oXL = Excel.Application
Set oWb = ActiveWorkbook
End If
Dim sld_no As Long
Dim course As String
Dim sld_offset As Long
Dim teamno As Long
Dim lead_sld As Long
Dim cntry As String
Dim pic_flag As Shape
Dim row_space As Shape
Dim team_range As Range
Dim school As String
Dim time_car As Double
Dim diff As Double
Dim time_one As Double
Dim pos As Long
Dim dist As Double
Dim dist_one As Double
Dim pplayout As CustomLayout
sld_no = SSW.View.CurrentShowPosition
'Acceleration leaderboard
If sld_no = 1001 Then
lead_sld = sld_no
With ActivePresentation
.Slides(lead_sld).Delete
End With
Debug.Assert lead_sld <> sld_no
Set oSld = ActivePresentation.Slides.AddSlide(lead_sld, GetLayout("accel"))
This code has a run-time error saying object required on this line...
Set objDataSets = objApp.ActiveMap.DataSets
This is what I used as a reference...
http://msdn.microsoft.com/en-us/library/aa723407.aspx
Sub CreateMaps()
Dim MPApp As MapPoint.Application
Set MPApp = New MapPoint.Application
MPApp.Visible = True
MPApp.UserControl = True
OpenDataSet
End Sub
Sub OpenDataSet()
Dim objDataSets As MapPoint.DataSets
Dim objDataSet As MapPoint.DataSet
Dim zDataSource As String
zDataSource = "S:\Projects\StateMapData.xlsx!Data!AY5:AZ56"
Set objDataSets = objApp.ActiveMap.DataSets
Set objDataSet = objDataSets.ImportData(zDataSource)
End Sub