Is there any way to Style a table with VBScript? All the solutions I'm finding online are for VBA.
for example, I tried the solution here Excel Macro - Select all cells with data and format as table with the following code
Set objExcel = CreateObject("Excel.Application")
Dim tbl
Set tbl = objWorkbook.ListObjects.Add(xlSrcRange, objWorkbook.Sheets("101").Range("$A$1:$C$26"), , xlYes)
tbl.TableStyle = "TableStyleLight1"
but I get this error
Microsoft VBScript runtime error: Object doesn't support this property or method: 'objWorkbook.ListObjects'
(If you have a solution for this in exceljs that would be even better)
I found something you may be able to use. It is from Using Styles to Dress Up Your Worksheets in Excel 2007. What I did was converted it from VBA to VBScript, which really wasn't that hard.
Sub ListStyles()
Dim objStyle
Dim objCellRange
Dim lngCount
Dim objSheet
Set objSheet = ThisWorkbook.Worksheets("Config - Styles")
With objSheet
lngCount = objSheet.UsedRange.Rows.Count + 1
For Each objStyle In ThisWorkbook.Styles
On Error Resume Next
Set objCellRange = Nothing
Set objCellRange = Intersect(objSheet.UsedRange, objSheet.Range("A:A")).Find(objStyle.Name, _
objSheet.Range("A1"), xlValues, xlWhole, , , False)
If objCellRange Is Nothing Then
lngCount = lngCount + 1
.Cells(lngCount, 1).Style = objStyle.Name
.Cells(lngCount, 1).Value = objStyle.NameLocal
.Cells(lngCount, 2).Style = objStyle.Name
End If
Next
End With
End Sub
To set this up, double click on the Sheet1 tab and rename it "Config - Styles". Add the code above, then run the script. What you end up with is this:
Related
I am new to VBA and macros.
I got the repeated task of copy data from Excel and paste it in a particular location in the word document.
For example, my excel sheet has the data like this:
Col1
Col2
ID_1
I'm_One
ID_2
I'm_Two
ID_3
I'm_Three
Now i'm looking for a Word macro
Get text in Word table with cell position 3
Find the same text in Excel Col1
Get the value of Col2 from Excel
Paste the value of Col2 in word table with cell position 10
Repeat the same process for another table in Word document
[Update]
I have tried with multiple code snippets by google search but unable to construct the working macro.
Sub pull_from_Excel2()
'ref: https://www.macworld.com/article/211753/excelwordvisualbasic.html
Dim Month As String
ID_Range = "A2:A6" 'Select this as range like "A2:A16"
Offset_to_fetch = 1 'Select this to fetch comments etc. value starts with
Set xlSheet = GetObject("D:\Excel.xlsx")
'Snippets:
'Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range("A3:A5").Value)
'8204
Dim Cell As Range, rng As Range
Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range(ID_Range).Value2)
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
For Each Cell In rng
Debug.Print Cell.Text
Next Cell
End Sub
I used this url to construct my skeleton code: https://www.macworld.com/article/211753/excelwordvisualbasic.html
When i try to get the values from the range of cells in excel, i got the following error for the code.
Set rng = xlSheet.Worksheets(1).Range(ID_Range).Value2
The above line gives "Object required" error when running.
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
The above line gives "Type Mismatch" error when running.
Notes: For this error, I tried to use for each loop as this is array but the error is showing before executing the for loop.
Kindly assist.
I recommend to use Option Explicit and declare all your varibales properly. This way it is less likely that you end up with unseen errors.
To activate it for all new codes that you add in the future, you can activate it directly in Excel and Word. This is a good practice and will protect you from doing it wrong by notifying you of not declared variables:
In the VBA editor go to Tools › Options › Require Variable Declaration.
This will add Option Explicit to new modules only. In existing modules Option Explicit needs to be added manually as first line.
Further I highly recommend to name your variables according what they contain because otherwise it gets very confusing. You named your variable xlSheet but you load a workbook into it and not a worksheet.
The next issue is that your code is in Word and if you declare rng As Range then this is of type Word.Range and not Excel.Range and those are diffetent types so that is why you get a "Type Mismatch" error.
To solve this you either go in Word VBA to Extras › Refereces … and set a reference to the Excel library so you can declare your variable Dim xlRng As Excel.Range or if you don't set a reference you declare it as Object or Variant like in below example:
' This code is in Word!
Option Explicit
Public Sub pull_from_Excel2()
'declare constants
Const ID_Range As Sting = "A2:A6" 'Select this as range like "A2:A16"
Const Offset_to_fetch As Long = 1 'Select this to fetch comments etc. value starts with
Dim xlWorkbook As Object
Set xlWorkbook = GetObject("D:\Excel.xlsx") 'This expects the Excel to be already open! If not open you need to use CreateObject("Excel.Application")
Dim xlRng As Object
Set xlRng = xlWorkbook.Worksheets(1).Range(ID_Range)
Dim xlCell As Object
For Each xlCell In xlRng
Debug.Print xlCell.Text
Next xlCell
End Sub
Note if your workbook Set xlWorkbook = GetObject("D:\Excel.xlsx") is not open in Excel you need to use CreateObject("Excel.Application") and open it.
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim xlWorkbook As Object
Set xlWorkbook = xlApp.Workbooks.Open(FileName:="D:\Excel.xlsx") 'will open the workbook
xlApp.Visible = True 'make it false to open Excel invisible in the background
'your code here …
'in the end close workbook and Excel (espaciall if you had it invisible!)
xlWorkbook.Close SaveChanges:=False
xlApp.Quit 'close Excel
Option Explicit
Sub UpdateTables()
Const XLSX = "D:\Excel.xlsx"
Dim xlApp, wb, ws
Dim rngSearch, rngFound
Dim iLastRow As Long, n As Integer
' open spreadsheet
'Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(XLSX, 1, 1)
Set ws = wb.Sheets(1)
iLastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row 'xlUp
Set rngSearch = ws.Range("A2:A" & iLastRow)
' update tables
Dim doc As Document, tbl As Table, s As String
Set doc = ThisDocument
For Each tbl In doc.Tables
s = tbl.Cell(1, 1).Range.Text
s = Left(s, Len(s) - 2)
Set rngFound = rngSearch.Find(s, LookIn:=-4163, LookAt:=1) ' xlValues, xlWhole
If rngFound Is Nothing Then
MsgBox "'" & s & "' not found in table " & tbl.Title, vbExclamation
Else
tbl.Range.Cells(3).Range.Text = rngFound.Offset(0, 1)
n = n + 1
End If
Next
wb.Close False
xlApp.Quit
MsgBox n & " tables updated", vbInformation
End Sub
I have the following routine below that is meant to open an Excel spreadsheet and then go row by row to import the results into a table that is passed in. It works fine but the problem is if I try to open that same spreadsheet a second time I get a message that the file is in use and I have to Ctrl-Alt-Del to shut down Excel before I can use it again. I thought that the Set mySheet=Nothing and Set xlApp=Nothing would release the file but apparently not. What more can I do to make sure that Access lets go of the Excel file? Thanks in advance!
Public Sub MakeTempTable(strFilePath As String, tablename As String)
Dim mySheet As Object
Dim xlApp As Object
Dim rs As DAO.Recordset
Dim sql As String
sql = "DELETE * FROM " & tablename
DoCmd.RunSQL sql
Set rs = CurrentDb.OpenRecordset(tablename)
Set xlApp = CreateObject("Excel.Application")
Set mySheet = xlApp.Workbooks.Open(strFilePath).Sheets(1)
xlApp.Visible = False
Set mySheet = xlApp.Sheets("Input")
Dim dRows As Double
dRows = 1
Dim dRow As Double, dCol As Double
dRow = 2
On Error GoTo ERR
Do
dCol = 1
rs.AddNew
If mySheet.cells(dRow, 3) = "" Then Exit Do
Do
If mySheet.cells(dRow, dCol).Value <> "_END_" Then
rs.Fields(dCol).Value = Nz(mySheet.cells(dRow, dCol).Value, "")
dCol = dCol + 1
Else
Exit Do
End If
Loop
rs.Update
dRow = dRow + 1
Loop
EXITSUB:
Set mySheet = Nothing
Set xlApp = Nothing
Exit Sub
ERR:
If ERR.Number = 3265 Then MsgBox "The species selected are incompatible. Canceling import.", vbCritical, "IMPORT ERROR"
GoTo EXITSUB
End Sub
Try using
xlApp.Quit
When you set xlApp to nothing you are only clearing the object within the procedure, you aren't doing anything to the actual Excel instance. All that setting XXX = nothing allows you to do is then reuse that object.
You will need to legally close the workbooks that are open as in
xlApp.Workbooks.Close
EXITSUB:
This will close the instances that are open.
Prior to this, kill all the instances or reboot your machine to clear all the instances that are open.
Good day to all.
For the past 8hrs, I am looking for a pivot alternative in Access 2007 since the reference dll is not available in our Citrix account (OWC10.dll). So I did all the effort I could do to research workaround on this but I have nothing so far, so I think its time for a little help.
What I have here is a sample of the raw data..
This is the end result I am looking for, a pivot table, in which of course, can be viewed in a form (best solution) or to an extracted excel file.
So basically, I need to display:
how much time they worked each day
how many they worked each day.
I tried the TRANSFORM Statement/Crosstab and I get the error that there is too much rows to make it a column since I do have 20,000+ rows - 30days/month * people who worked. - DISTINCT them, but I dont know how?
I don't have the .dll file in our system, so normal pivoting is out of question. Does anyone know any alternatives that can give me these display results?
What you'll need to do is compile a query of the data you require, and push this into excel, then programmatically build a pivot table in excel, from access.
I use ADO for pretty much everything - so the syntax I've got here reflects this; If you DAO, you'll need to translate it.
sql = _
"SELECT Name, ProcessDate, HandlingTime " & _
"FROM tbl ... WHERE ..."
GenerateSimplePivot(excel_path&file_name_to_create, sql, 2)
Private Sub GenerateSimplePivot(xname As String, auditData As String, _ pivotColumns As Long)
Dim ii As Long
Dim XL As Object
Dim WB As Object
Dim WS1 As Object
Dim WS2 As Object
Dim rst As ADODB.Recordset
'create/assign xl objects
Set XL = CreateObject("Excel.Application")
XL.Visible = False
XL.DisplayAlerts = False
Set WB = XL.Workbooks.Add
Set WS1 = WB.Worksheets(1)
Set rst = New ADODB.Recordset
rst.Open auditData, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
For ii = 0 To rst.Fields.Count - 1
WS1.Cells(1, ii + 1) = rst.Fields(ii).Name
Next
WS1.Range("A2").CopyFromRecordset rst
WS1.Columns.Autofit
WS1.Name = "AuditData"
For ii = 0 To rst.Fields.Count - 1
'add column formatting logic here, if required
Next
rst.Close
If WB.Worksheets.Count < 2 Then
Set WS2 = WB.Worksheets.Add(, WB.Worksheets(WB.Worksheets.Count))
Else
Set WS2 = WB.Worksheets(2)
End If
WS2.Name = "PivotTable"
DoCmd.SetWarnings False
Dim PTcache As Object
Dim pt As Object
WS1.Activate
Set PTcache = WB.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=WS1.Range("A1").CurrentRegion.Address)
Set pt = PTcache.CreatePivotTable(TableDestination:=WS2.Range("a6"), TableName:="PivotTable ")
WS2.Activate
With pt
For ii = (pivotColumns - 3) To 2 Step -1
.PivotFields(ii).Orientation = xlPageField
Next
On Error Resume Next
.PivotFields(1).Orientation = xlPageField
Err.Clear
ON Error GoTo [error handler label]
.PivotFields(pivotColumns - 2).Orientation = xlRowField
.PivotFields(pivotColumns - 1).Orientation = xlColumnField
.PivotFields(pivotColumns).Orientation = xlDataField
End With
WB.SaveAs FileName:=xname
WB.Close
Set WS1 = Nothing
Set WS2 = Nothing
Set PTcache = Nothing
Set pt = Nothing
Set WB = Nothing
XL.Quit
DoCmd.SetWarnings True
Set rst = Nothing
Set WS1 = Nothing
Set WS2 = Nothing
Set PTcache = Nothing
Set pt = Nothing
Set WB = Nothing
Set XL = Nothing
End Sub
Is this what you were after?
For others who are having the same trouble as I am. I made a solution using CrossTab.
Using the Query Wizard is very easy and understandable. Below is the edited SQL query to suit my needs:
TRANSFORM format(Sum(MyCopy.[Duration]), "hh:mm:ss") AS SumOfDuration
SELECT MyCopy.[UserID].[FullName], MyCopy.[TL], Sum(MyCopy.[Duration]) AS [Total Of Duration]
FROM MyCopy
Group BY MyCopy.[UserID], MyCopy.[FullName], MyCopy.[TL]
PIVOT MyCopy.[Process Date];
Note: For report purposes, its very easy to just extract this query. I did use format so that it won't look ugly with the decimals. Apparently, MS Access does not give the answers real numbers, but same percentage. It solves differently when sum of total duration passes 24hrs. So I left it on decimal format for correct numbers to appear.
I have an Access 2010 application where I run a SQL query and output the results to Excel. I'm using the Excel subtotal command to create subtotals. That works fine, but on the total rows only the text ("XXX Count") is bold and the values are not bold. Our client would like the entire row bold. I've tried a couple ways without success. How do I do the entire row in the subtotals?
So here is what I currently have:
This is correct except I need all of row 5, 8, 16, and 17 bold like this:
Here is my code to create the Excel file from Access (this all works except for the bold issues):
Public Sub ExportToExcel(query)
Dim appXL As Object
Dim wbk As Object
Dim wksNew As Object
Set appXL = CreateObject("Excel.Application")
Set wbk = appXL.Workbooks.Add
Set wksNew = wbk.Worksheets("Sheet1")
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
Set wbk = appXL.Workbooks.Add
Set wksNew = wbk.Worksheets(1)
Set cn = CurrentProject.AccessConnection
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Source = query
.Open
End With
With rs
'Put recordset into new wks
wksNew.Cells(2, 1).CopyFromRecordset rs
'And add headers
Dim i As Long
For i = 0 To .Fields.Count - 1
wksNew.Cells(1, i + 1).Value = .Fields(i).Name
wksNew.Cells(1, i + 1).Font.Bold = True
wksNew.Cells(1, i + 1).HorizontalAlignment = xlCenter
Next i
'Now, while the recordset is available...
'The recordset has .fields.count fields
'Subtotals are wanted from field 7 to the end
If .Fields.Count > 13 Then
ReDim ary(14 To .Fields.Count - 1)
For i = LBound(ary) To UBound(ary)
ary(i) = i
Next i
wksNew.Cells(1, 1).CurrentRegion.SubTotal GroupBy:=1, _
TotalList:=ary, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End If
.Close
End With
End Sub
I tried this code based on this website:
Dim rCell As Range
wksNew.Columns("A:A").Select
Dim rCell As Range
For Each rCell In Selection
If Right(rCell.Value, 5) = "Count" Then
Rows(rCell.Row).Interior.ColorIndex = 36
End If
Next
but it returned a "Method or data member not found" error on the item rCell.Value.
I also tried it like this:
Dim rCell As Range
wksNew.Columns("A:A").Select
For Each rCell In Selection
If Right(rCell, 5) = "Count" Then
Selection.Font.Bold = True
End If
Next
But I got the error "ActiveX component can't create object" on the For Each line.
How do I bold the entire row for the subtotals?
You're getting an error because Access doesn't know what Selection is unless you tell it that it's connected to your Excel instance.
For Each rCell In Selection
However, don't need to select anything, or check the whole column:
Dim rCell As Range
For Each rCell In wksNew.UsedRange.Columns(1).Cells
If Right(rCell, 5) = "Count" Then
rCell.Font.Bold = True
End If
Next
Have you tried a Pivot Table?? It is easier to manage format or layout and you don't have to change too much your code because you just put your RecordSet in a PivotTableCache like the second example in this.
Rather than looping, I'd suggest collapsing the outline and formatting the visible cells:
with wksNew.Cells(1, 1).CurrentRegion
.Outlinelevel = 2
.specialcells(12).Font.Bold = True
.Outlinelevel = 3
End With
Thanks for all the suggestions. No one posted a solution that worked entirely, so here's what I ended up using:
Dim c As Object
For Each c In wksNew.Range("A1:A500")
If c.Value Like "*Total" Then
c.Offset(0, 13).Font.Bold = True
c.Offset(0, 14).Font.Bold = True
c.Offset(0, 15).Font.Bold = True
End If
Next
The only thing that concerns me is that I'm assuming this only has 500 rows. I couldn't find a way to find the number of rows and have it search only those. If I included the whole column, it took a couple minutes to complete the loop which I didn't think the client would like. Any suggestions on how to find the last row?
I would
Display level 2 of the outline, all the subtotals
Select the whole area
Use GoTo Special to select only visible cells
Apply the formatting
Change the header row formatting if it should be different
Display all the levels again (level 3)
This code demonstrates:
Sub Macro4()
Application.ScreenUpdating = False
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Font.Bold = True
'change the header row if necessary
Range(Range("A1"), Range("A1").End(xlToRight)).Font.Italic = True
ActiveSheet.Outline.ShowLevels RowLevels:=3
End Sub
I have to know how can i link the excel database of Instrument loop Diagram in AutoCad format. I have AutoCad Template for a loop typical and Excel Database in which i have 100 Loops information for particular typical.I have AutoCad 2006,2007 and 2011 with me. please suggest idea for linking and generating he AutoCAD Drawings automatically.
The easiest way would be to learn a bit of AutoLisp, which is really worth learning if you're into generating drawings or automating your processes within AutoCAD.
Here's a great website for learning AutoLisp:
http://www.afralisp.net/index.php
AutoDesk's Lisp forum is also a great source of help.
As for extracting the data from Excel, here is a library which really facilitates access from AutoLisp:
http://download.cnet.com/KozMos-VLXLS/3000-2077_4-94214.html
'General rule: excel and acad have to be same like both 64bit or both 32 bit !!!
' You will need to add a reference to the AutoCAD
' Type Library to run this example book. Use the "Tools -
' References" menu. If you prefere you can switch to late
' binding by changeing the AutoCAD types to generic objects
Public Sub Excel_drives_acadPolyline_import_POINTs()
Dim objApp As AcadApplication
Dim objDoc As AcadDocument
Dim objEnt As AcadEntity
Dim varPnt As Variant
Dim strPrmpt As String
Dim intVCnt As Integer
Dim varCords As Variant
Dim varVert As Variant
Dim varCord As Variant
Dim varNext As Variant
Dim intCrdCnt As Integer
On Error GoTo Err_Control
Set objApp = AINTERFACE.Iapp
Set objDoc = objApp.activedocument
AppActivate objApp.CAPTION
objDoc.Utility.GetEntity objEnt, varPnt
If TypeOf objEnt Is AcadLWPolyline Then
AppActivate ThisDrawing.applicaTION.CAPTION
varCords = objEnt.COORDINATES
For Each varVert In varCords
intVCnt = intVCnt + 1
Next
For intCrdCnt = 0 To intVCnt / 2 - 1
varCord = objEnt.COORDINATE(intCrdCnt)
Excel.applicaTION.Cells(intCrdCnt + 1, 1).value = varCord(0)
Excel.applicaTION.Cells(intCrdCnt + 1, 2).value = varCord(1)
Next intCrdCnt
Else
MsgBox "Selected entity was not a LWPolyline"
End If
Exit_Here:
If Not objApp Is Nothing Then
Set objApp = Nothing
Set objDoc = Nothing
End If
Exit Sub
Err_Control:
'debug.print err.DESCRIPTION
Resume Exit_Here
End Sub
'----------------------------------------------------------------
' You will need to add a reference to the Excel
' Type Library to run this.In case of excel excel.exe is the library !
Sub acad-drives_excel()
Dim xAP As Excel.applicaTION
Dim xWB As Excel.Workbook
Dim xWS As Excel.WorkSheet
Set xAP = Excel.applicaTION
Set xWB = xAP.Workbooks.Open(SLOPEDIR.PROJECT & "\A2K2_VBA\IUnknown.xls")
Set xWS = xWB.Worksheets("Sheet1")
MsgBox "Excel says: """ & Cells(1, 1) & """"
Dim A2K As AcadApplication
Dim A2Kdwg As AcadDocument
Set A2K = AINTERFACE.Iapp
Set A2Kdwg = A2K.applicaTION.documents.Add
MsgBox A2K.NAME & " version " & A2K.version & _
" is running."
Dim HEIGHT As Double
Dim p(0 To 2) As Double
Dim TxtObj As ACADTEXT
Dim TxtStr As String
HEIGHT = 1
p(0) = 1: p(1) = 1: p(2) = 0
TxtStr = Cells(1, 1)
Set TxtObj = A2Kdwg.modelspace.AddText(TxtStr, _
p, HEIGHT)
A2Kdwg.SaveAs SLOPEDIR.PROJECT & "\A2K2_VBA\IUnknown.dwg"
A2K.documents.Close
A2K.Quit
Set A2K = Nothing
xAP.Workbooks.Close
xAP.Quit
Set xAP = Nothing
End Sub
Whatever way you choose now you can draw into the autocad drawing by using VBA.
There is another way for non programmers.
AUTOCAD SCRIPT
in fact you can create a excel table which creates this things and then you can export them to a text file. For simple task a solution but crap if you hase more complex things to do.
And last but not least you can create dynamic blocks and use vba to insert them and set the values of their parameters according to your excel sheet. But this would explode this tiny post