Excel now has the possibility to store personal filtering views to help collaboration in simultaniously used documents.
I could only find Microsoft documentation for an add-in, but the function is available in my Excel version of MS Excel for Microsoft 365 MSO (16.0.13127.20266) 32bit.
https://learn.microsoft.com/en-us/javascript/api/excel/excel.namedsheetview?view=excel-js-preview
I am trying to store the currently applied NamedSheetView name property (for later restoring option) but
this code fails:
Dim sh1 As Worksheet
Dim xViewName As String
Set sh1 = ThisWorkbook.Sheets(Sheet6.Name)
xViewName = sh1.NamedSheetView.Name
However this code works (with previously created "Test" view):
sh1.NamedSheetViews.GetItem("Test").Activate
If this NamedSheetViews is a collection, I should be able to get the item property, but these codes also fail:
strName = sh1.NamedSheetViews.GetItem(1).Name
strName = sh1.NamedSheetViews.Item(1).Name
Anyone has ever succeeded in getting the current NamedSheetView of a Worksheet?
Here is how I probe unknown Object properties:
I start with a reference to the Object. If I don't know what the Object is I use TypeName() to return it's class name (data type). I then declare a variable of that data type. Wash, rinse and repeat as I drill down the structure. Once the variable is declared, selecting the variable and pressing F1 with open the Microsoft Help document for that data type.
Module Code
Sub WhatIsThat()
Const TestName As String = "TestName"
Dim View As NamedSheetViewCollection
Set View = Sheet6.NamedSheetViews
On Error Resume Next
View.GetItem(TestName).Delete
On Error GoTo 0
View.Add TestName
Dim SheetView As NamedSheetView
Dim n As Long
For n = 0 To View.Count - 1
Debug.Print View.GetItemAt(n).Name
Set SheetView = View.GetItemAt(n)
Debug.Print SheetView.Name
Next
Stop
End Sub
Immediate Window Tests
?TypeName(Sheet6.NamedSheetViews)
?View.GetItemAt(0).Name
?TypeName( View.GetItemAt(0))
SOLUTION:
(Thanks for the great help from TinMan)
Dim SheetView As NamedSheetView
Dim sh1 As Worksheet
Dim ActiveSheetView as string
Set sh1 = ThisWorkbook.Sheets(Sheet6.Name)
Set SheetView = sh1.NamedSheetViews.GetActive
ActiveSheetView = SheetView.Name
Application:
sh1.NamedSheetViews.GetItem(ActiveSheetView).Activate
Related
I have a set of word documents that I want to auto-fill for different clients and I am trying to write a VBA application to accomplish that. I have information about the client, such as today's date and their name, stored in an Excel sheet, and I want to copy that information on multiple Word documents with labels on them. The goal is for every new client, the user would only need to update the client information on the Excel sheet to auto-fill the Word documents.
The below code is what I have right now. objDocument represents the Word document that I am trying to fill in and exWb is the Excel sheet in which I am trying to copy client information from. The Excel sheet has cells named TodayDate and ClientName which stores the respective client information. The Word document has ActiveX control labels named TodayDate, ClientName, and ClientName1 which will be filled in with the corresponding information from the Excel Sheet. ClientName and ClientName1 both contain the information from the "ClientName" cell, but because I cannot have 2 labels of the same name in Word, they are named as such.
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
On Error Resume Next
objDocument.TodayDate.Caption = exWb.Sheets("Sheet1").Range("TodayDate").Value
On Error Resume Next
objDocument.ClientName.Caption = exWb.Sheets("Sheet1").Range("ClientName").Value
On Error Resume Next
objDocument.ClientName1.Caption = exWb.Sheets("Sheet1").Range("ClientName").Value
On Error Resume Next
To make the code more readable, I would like to format it into a for loop, but I am not sure how to declare a variable that can refer to the names of Word document labels in a for loop. I was thinking of using arrays to store the names of Word labels and Excel cells and loop through the list. I suppose it would look something like this:
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
WordLabelList = [TodayDate, ClientName, ClientName1]
ExcelNames = ["TodayDate", "ClientName", "ClientName"]
Dim i as Integer
for i in range(1, length(WordLabelList))
On Error Resume Next
objDocument.WordLabelList[i].Caption = exWb.Sheets("Sheet1").Range(ExcelNames[i]).Value
Next
Or to make it even better, use a dictionary with ExcelNames as the key and WordLabelList as the values so that I do not have to repeat values in the ExcelNames array:
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
ClientInfo = {"TodayDate":[TodayDate], "ClientName": [ClientName, ClientName1]}
for info in ClientInfo
for label in ClientInfo[info].value
On Error Resume Next
objDocument.label.Caption = exWb.Sheets("Sheet1").Range(info).Value
Next
Please let me know how I can achieve any of the above with proper VBA syntax or if you have a more efficient suggestion that is better than re-writing multiple lines in original code.
The only thing you're missing seem to be a way to address an ActiveX control by its name? Once you have that your code gets much simpler.
For example:
Sub Tester()
Dim doc As Object, lbl As Object, nm
Set doc = ThisDocument
For Each nm In Array("TodayDate", "ClientName")
Set lbl = DocActiveX(doc, nm) 'get a reference to an embedded ActiveX control
If Not lbl Is Nothing Then
lbl.Caption = "this is - " & nm
Else
Debug.Print "Control '" & nm & "' not found"
End If
Next nm
End Sub
'return a reference to a named ActiveX control in document `doc`
' (or Nothing if not found)
Function DocActiveX(doc As Document, xName) As Object
Dim obj As Object
On Error Resume Next
Set obj = CallByName(doc, xName, VbGet)
On Error GoTo 0
Set DocActiveX = obj
End Function
I wrote a macro in Excel VBA to make users send their Excel-File via E-Mail automatically back to me.
To use this macro every user must install the Outlook Library. For this I created the function add_outlook. If I try to run the function it works.
The only problem occurring is that VBA doesn't let me debug. When stepping through the code I get the Errormsg "Cant enter break mode at this time"
Is there a workaround or fix?
Thanks a lot!
Option Explicit
Public Function add_outlook()
'DEBUGGING DOESNT WORK
'late binding
Dim vbProj As Object
Set vbProj = ThisWorkbook.VBProject
Dim vbRefs As Object
Set vbRefs = vbProj.References
Dim vbRef As Object
'Libary GUID and Data
Dim libname As String
libname = "Outlook"
Dim guid As String
Dim major As Long
Dim minor As Long
Dim exists As Boolean
guid = "{00062FFF-0000-0000-C000-000000000046}"
major = 9
minor = 6
'Reference cleanup function
For Each vbRef In vbRefs
If vbRef.Name = libname Then
'problem occurs here
vbRefs.Remove Reference:=vbRef
End If
Next
'add Ref
vbRefs.AddFromGuid guid:=guid, major:=major, minor:=minor
End Function
Solution:
Sub Workbook_Open()
Call add_outlook
End Sub
Cant step through code
Get reference when Workbook_open event is triggered
I have a code that exports image from excel into a picturebox and here it is.
Dim appExcel As Object
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = False
Dim xlsBook As New excel.Workbook
Dim xlsSheet As New excel.Worksheet
Dim rowlocation As Integer
Dim columnlocation As Integer
Dim celladdress As String
Set xlsBook = appExcel.Workbooks.Open(Text1.Text)
Set xlsSheet = xlsBook.Worksheets("Sheet1")
Dim x As excel.Shapes
For Each x In xlsSheet.Shapes
x.Copy
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
Text2.Text = x.Name
rowlocation = x.TopLeftCell.Row
columnlocation = x.TopLeftCell.Column
celladdress = xlsSheet.Cells(x.BottomRightCell.Row + 1, x.TopLeftCell.Column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
MsgBox ActiveSheet.Range(celladdress)
Next
End If
and unfortunately this code wont work on my friends PC becuase he does not have an Excel installed but he has OpenOffice spreadsheet. I tried to open the Excel in Openoffice then the file opens now my goal is how can i convert the code above in OpenOffice? I mean run the code for OpenOffice files.
This is my code but its not working
Dim objServiceManager As Object
Dim objDesktop As Object
Dim objDocument As Object
Dim objText As Object
Dim objCursor As Object
Dim oDoc As Object
Dim ARG()
Dim oGraph As Object
Dim oView As Object
Dim oDrawPage As Object
Dim oSheet As Object
Dim Image As System_Drawing.Image
Dim oimage As Object
Dim osize As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Set oDoc = objDesktop.loadComponentFromURL("file:///C:\Users\paul\Desktop\Testing.ods", "_blank", 0, ARG())
Set oSheet = oDoc.getSheets().getByIndex(0)
Set oGraph = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oView = oDoc.CurrentController
Set oDrawPage = oView.getActiveSheet.DrawPage
For i = 0 To 2
For j = 0 To 9
' Form1.Image1.Picture = Clipboard.GetData
Form1.Image1.Picture = LoadPicture(oDrawPage)
Next
Next
TYSM for future help
This is the latest code in VB6 and it has an error saying vnd.sun.star is missing
Dim objServiceManager As Object
Dim objDesktop As Object
Dim objDocument As Object
Dim objText As Object
Dim objCursor As Object
Dim oDoc As Object
Dim ARG()
Dim oGraph As Object
Dim oView As Object
Dim oDrawPage As Object
Dim oSheet As Object
Dim Image As System_Drawing.Image
Dim oimage As Object
Dim osize As Object
Dim Cell As Object
Dim sGraphicUrl As String
Dim oDisp
Dim oFrame
Dim opos As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Set osize = objServiceManager.Bridge_GetStruct("com.sun.star.awt.Size")
Set opos = objServiceManager.Bridge_GetStruct("com.sun.star.awt.Point")
Set oDoc = objDesktop.loadComponentFromURL("file:///C:\Users\paul\Desktop\ACE Express - Fairview_Sample PC of Gondola.ods", "_blank", 0, ARG())
Set oSheet = oDoc.getSheets().getByIndex(0)
Set oimage = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oView = oDoc.CurrentController
Set oDrawPage = oView.getActiveSheet.DrawPage
Set oimage = oDrawPage.getByIndex(0)
Image1.Picture = LoadPicture(oimage.GraphicURL)
Here is the output of the unzip picture
I do not know exactly what your code does, because I normally do not use Microsoft Office. However it looks like this task can be accomplished using OpenOffice Basic. One of the best places to learn OpenOffice Basic is Andrew Pitonyak's Macro Document.
To start with, look at section 5.9.5. Convert all linked images.
EDIT:
To do this in Calc, first I went to Tools -> Macros -> Organize Dialogs and created a dialog named "ImageViewerForm" with an image control named "MyImageControl".
Then I went to Tools -> Macros -> Organize Macros -> OpenOffice Basic and added the following code:
Sub ShowImageViewerDialog
oDoc = ThisComponent
oDlg = CreateUnoDialog(DialogLibraries.Standard.ImageViewerForm)
oControl = oDlg.Model.MyImageControl
oDrawPage = oDoc.getDrawPages().getByIndex(0)
oImage = oDrawPage.getByIndex(0)
oControl.ImageURL = oImage.GraphicURL
oDlg.execute()
End Sub
To run the code, go to Tools -> Macros -> Run Macro. Here is the result:
The "Next Image" button should be fairly straightforward to implement by adding an event handler.
For documentation, see GraphicObjectShape and UnoControlButtonModel. But mostly I just used the MRI tool to figure it out.
EDIT 2:
Regarding the error you posted, the GraphicURL property in this case is a string that references an in-memory object, not a filepath. An example of the string is shown here: https://www.openoffice.org/api/docs/common/ref/com/sun/star/graphic/XGraphicObject.html.
So it is not suitable for passing to LoadPicture, which takes a filename.
Perhaps you can get the actual image data from oImage.Bitmap or oImage.Graphic. Use MRI to see what attributes are available.
For example, it looks like there is a getDIB() method that might work like this:
Form1.Image1.Picture = oImage.Bitmap.getDIB()
One more idea: Instead of using an Office application, you could write code that unzips the file and reads each image in the Pictures subdirectory.
I have never tried it but according to the docs you can control Open Office through COM automation.
Your VB6 code above is controlling Excel through COM automation. You could install Open Office on your machine, and see whether you can automate Calc from VB6 to open a spreadsheet and extract an image. I don't know whether it allows that. Excel COM automation is very powerful and allows you to do almost anything, Open Office may not be as powerful (I don't know).
I would advise thinking carefully about what problem you are trying to solve and whether there's another approach entirely!
I have a button in Access (2003) that transfers data to Excel (also 2003). It opens the Excel workbook, then cycles through the Access subforms and transfers data.
To give more information on how this works, Excel has a range called "Tables" which contains the names of the Access subforms ("Main", "Demographics", "History", etc). Excel also has a range for each of the names in that first range. For example, the range "Demographics" contains a series of field names ("FirstName", "LastName", etc). So the first loop moves through the subforms, and the nested loop moves through the field names. Each field then passes the value in it over to excel. Excel also has ranges for "Demographics_Anchor" and "History_Anchor" etc, which is the first value in the column next to each range (ie the range Demographics has firstname, lastname, and to the right is where the data would go. So the first item in the range is FirstName, to the right "Demographics_Anchor" is where firstname will go. Then LastName goes to Demographics_Anchor offset by 1 - or 1 cell down from the anchor).
Dim ThisForm As Form
Dim CForm As Object
Dim CTab As TabControl
Dim CControl As Control
Dim CurrentTab As Variant
Dim CControlName As Variant
Dim CControlValue As String
Dim Code As Control
Dim counter1 As Integer
Dim appExcel As Object
Dim Anchor As Object
Dim PageRange As Object
Dim ControlNameRange As Object
strpath = "C:\blah\blah\filename.xlsm"
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open Filename:=strpath, UpdateLinks:=1, ReadOnly:=True
Set wbk = appExcel.ActiveWorkbook
Set PageRange = appExcel.Range("Tables")
'set Access environment
Set ThisForm = Forms("frmHome")
Set CTab = ThisForm.Controls("Subforms")
'export the data from Access Forms to Excel
For Each CurrentTab In PageRange
If CurrentTab = "Main" Then
Set CForm = ThisForm
Else
CTab.Pages(CurrentTab).SetFocus
Set CForm = ThisForm.Controls(CurrentTab & " Subform").Form
End If
Set ControlNameRange = appExcel.Range(CurrentTab)
Set Anchor = appExcel.Range(CurrentTab & "_Anchor")
counter1 = 0
For Each CControlName In ControlNameRange
Set CControl = CForm.Controls(CControlName)
CControl.SetFocus
Anchor.Offset(RowOffset:=counter1).Value = CControl.Value
counter1 = counter1 + 1
Next CControlName
Next CurrentTab
I hope this explains what is going on in the code. I just can't figure out why this keeps bombing out with type mistmatch (error 13).
The data DOES transfer. It goes through the entire code and every piece of data correctly gets transferred over. It bombs out at the end as if it goes through the code 1 last time when it shouldn't. I did confirm that every range is correct and doesn't contain any null values. The code bombs out on this line: Set CControl = CForm.Controls(CControlName) which is towards the bottom of the second loop.
Please help! I've spent weeks working with this code and had no luck. This exact code works in every other database I've worked with.
You are getting the name of the control CControlName from your Excel Range, but then setting the value of this control to the control on the Access form Set CControl = CForm.Controls(CControlName). From this, the most likely explanation is probably that the CControlName isn't actually on the Access form (perhaps a typo?).
In the VBA IDE, go under the Tools Menu, select Options and then select the General tab. Under the Error Trapping section, select the "Break on All Errors" option and click "OK" to set the preference. Run your code again; when an error is encountered VBA will stop processing on the line that caused the error. Check the value of CControlName and make sure it actually exists on the Access form.
I keep getting:
a Run-time error '1004' Unable to get the Vlookup property of the WorksheetFunction class
with the Vlookup code below.
If I enable Microsoft outlook 12.0 Object Library it works but I run into issues where the code is used with Excel 2013 and adds Microsoft outlook 15.0 Object Library references that are not available on excel 2007. I have incorporated late binding which has worked for the most part except for this one bit of code.
I have included a snippet of code which I hope is enough for someone to help me.
Sub Button154_Click()
Dim forename As String
Dim surname As String
Dim movedate As String
Dim callref As String
Dim dept As String
Dim deptmove As String
Dim wb As Workbook
Set wb = ThisWorkbook
forename = Sheet1.Range("f8").Value
surname = Sheet1.Range("f9").Value
movedate = Sheet1.Range("k13").Value
callref = Sheet1.Range("k8").Value
dept = Application.WorksheetFunction.VLookup(Name, Sheet1.Range("K10"), 1)
Added late binding code
Dim otlApp As Object
Set otlApp = CreateObject("Outlook.Application")
An changed the vlookup to:
dept = Application.WorksheetFunction.VLookup(oltApp, Sheet1.Range("K10"), 1)
Now works great