Apply VBA macro to different pages in Visio - vba

At the moment, I have a Visio file that hasa network zoning diagram (Page 1) where a user can put shaped in different zones. One can run a VB macro over that page, which will collect all kinds of data that is specific to those shapes and flows and exports it to a Word file for further reporting. That's all good and work as expected.
However, the networking zoning is different on for instance cloud. So, I want to make another page (Page 2) in the same file, that has more cloud (GCP, AWS) oriented zoning details (VPC etc.). And I want to run the same macros over that Page (2) to export the details to a word file.
PROBLEM: How and where should I tell the macro which Page it should get the data from in order to run the output. I have been playing with things like "Set vsoPage = ActiveWindow.Page" and have that executed before the macro collects all the meta information of the shapes
My hope was, based on the MS Visio page, that the macro would grab the shapes from the page that would have been active.
But no, it just spits out stuff on Page 1. And not Page 2 (although active).
Just wondering if:
- this is the right line of code to use?
- is the location correct?
Many thanks for your help

More likely to be:
Set vsoPage = ActivePage

I'm not exactly sure how and when your macro works, but here's some snippets that might help:
'// Get the active page:
Dim visPg as Visio.Page
Set visPg = Visio.ActivePage
If Not(visPg Is Nothing) Then
...
End If
'// Here we'll be really picky about the active window, this is
'// probably overkill, but Visio can have several different types
'// of active windows:
Dim visPg as Visio.Page
Dim visWin As Visio.Window
Set visWin = Visio.ActiveWindow
If (visWin .Type = Visio.VisWinTypes.visDrawing) Then
If (visWin .SubType = Visio.VisWinTypes.visPageWin) Then
'// The active window is a drawing page window, and not
'// a master-editing window, nor a group-editing window:
Set visPg = visWin.Page
'//...do stuff with visPg
End If
End If

Related

How to prevent loss of 'link' for embedded chartdata

I'm currently receiving a 'Linked File Not Available' error when trying to manually open datasets for embedded charts in Word after successfully updating these datasets via a VBA script. I am trying to build a project which will allow users to automatically update a series of embedded charts based on a user defined worksheet which is produced monthly.
In order to support this project, I've been trying to find a way in which I can update chart data in Word using VBA while avoiding the ChartData.Activate method (eventually crashes the program due to the burden of successive open / close actions [context: I have around 300 charts in the largest of these reports]).
I've attempted to update the data using a direct call to the ChartData.Workbook and ChartData.ActivateChartDataWindow both of which allow me to successfully update the data. Following the successful update however, I get the below error when trying to access the dataset manually and can no longer access it via the Macro:
Linked File Not Available
I know I am probably missing something simple, or perhaps am approaching this in the wrong way by going through Word but wanted to throw it out there to see if anyone has a solution which could resolve / explain what's causing the loss of these 'links' to embedded datasets?
Chart Screenshot (Front)
Chart Screenshot (Data)
To try and streamline testing; I've created a stripped down version of the overall code which I've been using to try and troubleshoot:
Dim x As Integer 'Counter used to breakout of routine once 1 chart updated.
Dim strChartTitle As String
Dim objChart As InlineShape
Dim objTargetWorkbook As Workbook
Dim objTargetWorksheet As Worksheet
x = 0
For Each objChart In ActiveDocument.InlineShapes
strChartTitle = objChart.Chart.ChartTitle.Text
If x = 1 Then
Exit Sub
ElseIf strChartTitle Like "EHR Transactions Summary (By Endpoint)*" Then
'objChart.Chart.ChartData.Activate
objChart.Chart.ChartData.ActivateChartDataWindow
Set objTargetWorkbook = objChart.Chart.ChartData.Workbook
Set objTargetWorksheet = objTargetWorkbook.ActiveSheet
objTargetWorksheet.Range("C1:D11").Copy objTargetWorksheet.Range("B1")
objTargetWorksheet.Range("D1").Value = DateAdd("m", 1, objTargetWorksheet.Range("C1").Value)
x = 1
objTargetWorkbook.close
End If
Next objChart
Problem:
Couldn't find a way to update data on a large number of charts using vba without utilising the Chart.ChartData.Activate or Chart.ChartData.ActivateChartDataWindow commands which either caused crash due to CPU load on successive load / unload (former method) or broke links between the embedded charts and their datasheets (latter method).
Solution:
Solution was provided in part by #Slightly Snarky in comment to original question / problem post. Despite Microsoft's documentation, it is possible to update data within Chart workbooks without the need to call an activate command by referencing the workbook and worksheet directly.
Re-wrote script to utilise the new method and confirmed not only did this allow me to edit data; it was able to do so while avoiding the performance hit inherent in the repeated open / close events caused by the two above methods.
On testing; one problem did come up in that MS-Word would spin up a new Excel sub-process each time the code referenced a different chart without killing the previous sub-process. Given these reports have up to 300 charts, this inevitably caused the routine to crash once enough sub-processes had built up against the CPU.
To resolve this issue, I tweaked the code to include a ChartData.Workbook.Close command after each chart update completes which has helped keep CPU burden to a minimum and prevented crashes due to overloading with Excel sub-processes.
Dim strChartTitle As String
Dim objChart As InlineShape
For Each objChart In ActiveDocument.InlineShapes
strChartTitle = objChart.Chart.ChartTitle.Text
If strChartTitle Like "EHR Transactions Summary (By Endpoint)*" Then
With objChart.Chart.ChartData.Workbook.Worksheets(1)
.Range("C1:D11").Copy objChart.Chart.ChartData.Workbook.Worksheets(1).Range("B1")
.Range("D1").Value = objChart.Chart.ChartData.Workbook.Worksheets(1).Range("D1").Value = DateAdd("m", 1, objChart.Chart.ChartData.Workbook.Worksheets(1).Range("C1").Value)
End With
objChart.Chart.ChartData.Workbook.close
End If
Next objChart

Powerpoint VBA Presentations File names

Consider VBA for PowerPoint -
Is this a valid Presentations function call?
Presentations(".\directory\ppname.ppt")
Note that this will be called from within a PowerPoint presentation VBA, to open another one in a sub-directory.
The Microsoft Presentations examples (and most others) are not specific about the filename forms accepted, e.g. those using the ".", "..", "\" directives recognized in DOS scripts.
This seems to work with Powerpoint 2007.
As described in the comment, it takes a block of text (the TextRange), the starting position and length of file reference, also a LinkAddr. LinkAddr is essentially a DOS-style file reference, like "..\folder\ppfile.ppt".
The intention here is to launch another PowerPoint tool by invoking its show.ppt or show.ppsm file name. The file name can refer to some other directory using MSDOS file name stuff. I don't know whether it can span different machine platforms, but it seems to work within one Windows 10 system.
My difficulty in getting this to work was some full-path links to images, e.g. something like C:\blah\blah\image.jpg, in the Visual Basic code. PowerPoint didn't like these, instead asked about enabling macros, and just hung up when one of my file links were to be executed. By getting rid of the "macro" complaints, this suddenly started working.
Or maybe some bugs have been fixed in recent repairs to my 2007 PowerPoint tools??
Go figure...
Sub InsertLink(ByRef Trange As TextRange, fpos As Long, msglen As Long, LinkAddr As String)
' Insert an HTML link into the selected TextFrame.
' get the character range
Dim Hrange As TextRange
Set Hrange = Trange.Characters(Start:=fpos, length:=msglen)
' make it an HTML link
With Hrange.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = LinkAddr
End With
End Sub

Splitting MS Publisher 2010 document into multiple files

I want to split a multi-page MS Publisher 2010 document into a set of separate documents, one per page.
The starting document is from a mail-merge, and I am trying to produce a set of numbered and named tickets as PDFs to send to people for an event (this is for a charity). The mail-merge seems to work fine and I can save the merged document and it looks OK with e.g. a list of fifty people giving me a 50-page document.
Ideally the result would be a set of PDFs.
I have tried to create some simple VBA code to do this, but it is not working consistently. If I try this very simple macro below , I get the correct number of documents, but only perhaps 1 or 2 documents with the correct contents out of every five. Most of the documents are completely empty.
Sub splitter()
Dim i As Integer
Dim Source As Document
Dim Target As Document
Set Source = ActiveDocument
For i = 1 To Source.Pages.Count
Set Target = Documents.Add
Source.Pages(i).Shapes.Range.Copy
Target.Pages(1).Shapes.Paste
Target.SaveAs Filename:="C:\Temp\Ticket_" & i
Target.Close
Set Target = Nothing
Next i
End Sub
I did sometimes get an error that the clipboard is busy, but not always.
Another approach might be to start with the master document and do this looping over the separate documents and fill in the personal details for each person's ticket and directly produce the PDFs. But that seems more complex, and I am not a VB programmer (but been doing C++ etc for 20+ years, so I can program :-) )
A final annoyance is that it seems to keep opening a new Publisher window for each document. It takes a while to then close 50+ copies of publisher, and the laptop starts to crawl...
Please advise how best to get round these issues. I am probably missing something trivial, being a relative VB(A) newbie.
Thanks in advance for any suggestions
Try coding something like this:
Open Publisher application (CreateObject()?)
Open Publisher document (doc.Open(filename))
Store the total amount of pages in a global variable (doc.Pages.Count)
Close document (doc.Close())
Loop the following for each page
Copy the pub file and rename it to name & "page" & X
Open the new pub file
Remove all Pages except page X from the pub file
doc.Save()
doc.Close()
Copying files with VBA is easy, but copying pages in Publisher VBA is quite a hassle, so this should be easier to achieve

Reading, Writing and controlling Autocad using external VBA

I'm using MS-Access 2010 and Autocad 2012 64bit and work in manufacturing.
I want to be able to at the very least, populate fields in a title block, better still I would like to use data in my access database to write data into a sheet set (the current system works by reading the sheet set values such as sheet title and number into my title block).
The following code is all I have at the moment and it will open autocad and write the date into the command line.
Private Sub OpenAutocad_Click()
Dim CadApp As AcadApplication
Dim CadDoc As AutoCAD.AcadDocument
On Error Resume Next
Set CadApp = GetObject(, "AutoCAD.Application")
If Err.Number <> 0 Then
Set CadApp = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0
CadApp.Visible = True
CadApp.WindowState = acMax
Set CadDoc = CadApp.ActiveDocument
CadDoc.Utility.Prompt "Hello from Access, the time is: " & TheTime
Set CadApp = Nothing
End Sub
I have no idea where to go from here. What are the commands to control the sheet set manager and change data, and can the .dst file be edited without even opening up autocad? is there a list of all available autocad vba commands and functions?
If you are declaring CadApp as AcadApplication you must have added a reference to AutoCAD.
That means you should be able to see the object model using your Object Browser in your VBA IDE. No?
There is also a very helpful site www.theswamp.org which has a whole section devoted to AutoCAD VBA.
If I understand your question correctly, you want to automate filling attributes in a drawing title blocks (such as title, drawer, part number, etc) right from MS Access.
Your code can access the Autocad command line already, but Autocad doesn't seem to have the exact command for filling drawing attribute. (command list)
So looks like you need to fill the attributes programatically using the COM API.
The following question appears to be relevant with yours and the accepted answers does provide a sample code:
Is it possible to edit block attributes in AutoCAD using Autodesk.AutoCAD.Interop?
Note that in that question the asker was developing a standalone application in C# .NET, where as you will be using VB Automation from MS Access. Shouldn't be too different since the Component Object Model (COM) being used is the same.
What are the commands to control the sheet set manager and change data and can the .dst file be edited without even opening up autocad?
(sorry can't post more than 2 links)
docs.autodesk.com/ACD/2010/ENU/AutoCAD%202010%20User%20Documentation/files/WS1a9193826455f5ffa23ce210c4a30acaf-7470.htm
No mention about data change, though.
is there a list of all available autocad vba commands and functions?
Yes.
%ProgramFiles%\Common Files\Autodesk Shared\acad_aag.chm - Developer's Guide
%ProgramFiles%\Common Files\Autodesk Shared\acadauto.chm - Reference Guide
Online version:
help.autodesk.com/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-36BF58F3-537D-4B59-BEFE-2D0FEF5A4443.htm
help.autodesk.com/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-5D302758-ED3F-4062-A254-FB57BAB01C44.htm
More references here:
http://usa.autodesk.com/adsk/servlet/index?id=1911627&siteID=123112
:) Half the way gone ;)
If you has a open autocad with a loaded drawing you can access the whole thing directly.
Sub block_set_attribute(blo As AcadBlockReference, tagname, tagvalue)
Dim ATTLIST As Variant
If blo Is Nothing Then Exit Sub
If blo.hasattributes Then
tagname = Trim(UCase(tagname))
ATTLIST = blo.GetAttributes
For i = LBound(ATTLIST) To UBound(ATTLIST)
If UCase(ATTLIST(i).TAGSTRING) = tagname Or UCase(Trim(ATTLIST(i).TAGSTRING)) = tagname & "_001" Then
'On Error Resume Next
ATTLIST(i).textString = "" & tagvalue
Exit Sub
End If
Next
End If
End Sub
Sub findtitleblock(TITLEBLOCKNAME As String, attributename As String,
attributevalue As String)
Dim entity As AcadEntity
Dim block As acadblcck
Dim blockref As AcadBlockReference
For Each block In ThisDrawing.BLOCKS
For Each entity In block
If InStr(LCase(entity.objectname), "blockref") > 0 Then
Set blockref = entity
If blockref.effectivename = TITLEBLOCKNAME Then
Call block_set_attribute(blockref, attributename, attributevalue)
exit for
End If
End If
End If
Next
Next
End Sub
call findtitleblock("HEADER","TITLE","Bridge column AXIS A_A")
So assume you has a title block which has the attribute TITLE then it will set the Attribute to the drawing name. it mioght also possible you has to replace the thisdrawing. with your Caddoc. I usually control Access and Excel form autocad and not vice versa ;)
consider also to use "REGEN" and "ATTSYNC" if "nothing happens"
thisdrawing.sendcommens("_attsync" 6 vblf )

VBA error when opening shared file - reading tags is treated as attempt to modify

I have come across a strange error and am looking for some insights.
Scenario:
A powerpoint file on a shared drive is opened by user A. User B now wants to open the same file, and is presented with a "open as read only?" dialog. User clicks "OK".
The file is opened, and an add-in runs (whenever a file is opened) to check for certain tags on slides, indicating presence of confidential material. This causes an error in the following function:
Function taggedSlide(tagName As String)
' find the slide which is tagged with tagName
Dim oSl As Slide
Set oSl = Nothing
For Each oSl In ActivePresentation.Slides
If Len(oSl.Tags(tagName)) > 0 Then <<<<<<<<<<<<<<< this is the line that causes error
Set taggedSlide = oSl
Exit Function
End If
Next oSl
Set taggedSlide = Nothing
End Function
The function ostensibly loops over all slides in the presentation, looks for a tag called tagName, and returns the slide (or Nothing). It looks like this only involves "read" operations, but the code throws an error at the indicated line.
To make things more interesting, the behavior is different if I simply mark a file as "read only", save it, and open it. The difference seems to be that I can modify the file in that case - I just can't save it. But this file cannot be edited at all, even if I don't save it. And the above "read" operation is treated as a "modification"...
I have the following questions:
Is there a document property that I can read in VBA to tell me this is a "cannot modify" file? I am looking for something akin to ActivePresentation.ReadOnly, but that is set for a "read only" file, and this is different.
Why does the line If Len(oSl.Tags(tagName)) > 0 Then get treated as a "modifying file" operation?
It was difficult to reproduce this error, because I really needed to have two users open the same file (saving the file as read-only was not enough) to make it happen. Looking forward to your insights / comments / answers!