I try to create a word document with two tables with Autohotkey. I could successfully add one table and type some text. Now I try to create another table in the same document below old table.
oWord := ComObjCreate("Word.Application") ; create MS Word object
Document := oWord.Documents.Add ; create new document
oWord.Visible := 1 ; Make winword visible
range := oWord.ActiveDocument.Range(0, 0) ; Set Range
oWord.ActiveDocument.tables.Add(range,1,2) ; Add table in range
oWord.Selection.Tables(1).Style := "Table Grid" ; set style
oWord.Selection.Tables(1).Cell(1,2).Range.Select ; select a cell
oWord.Selection.TypeText("Hi hi") ; type a text in selected cell
oWord.Selection.EndKey ; from here I couldn't able to create a new table
oWord.Selection.TypeParagraph
range := oWord.ActiveDocument.Range(0, 0)
oWord.ActiveDocument.tables.Add(range,10,5)
oWord.Selection.Tables(1).Style := "Table Grid"
oWord.Selection.Tables(1).Cell(1,3).Range.Select ; get error 0x800A1735 and it mentions 'Cell' The requested member of the collection does not exist
;oWord.Selection.TypeText("Hi di")
oWord.Quit
What wrong I am doing here?
;OP reports being unable to add a second table.
;The following AutoHotkey code demonstrates the use of Selection.Range to properly place the additional table.
full_command_line := DllCall("GetCommandLine", "str")
if not (A_IsAdmin or RegExMatch(full_command_line, " /restart(?!\S)"))
{
try ; leads to having the script re-launching itself as administrator
{
if A_IsCompiled
Run *RunAs "%A_ScriptFullPath%" /restart
else
Run *RunAs "%A_AhkPath%" /restart "%A_ScriptFullPath%"
}
ExitApp
}
oWord := ComObjCreate("Word.Application")
; create MS Word object
Document := oWord.Documents.Add
; create new document
oWord.Visible := 1 ; Make winword visible
range := oWord.Selection.Range
; Set Range - this was at the heart of the problem
; reported by OP
oWord.ActiveDocument.tables.Add(range,11,5)
; Add table in range with 11 rows and 5 columns
oWord.Selection.Tables(1).Style := "Table Grid"
; set style to Table Grid
oWord.Selection.Tables(1).Cell(1,1).Range.Select
; select a cell ("A1" in Excel parlance)
oWord.Selection.TypeText("A1")
; type identifying text in selected cell
oWord.Selection.MoveDown(5, 12, 0)
; wdLine := 5, Count has no constant. wdMove is 0, wdExtend is 1
oWord.Selection.TypeText("Ending first table.")
oWord.Selection.TypeParagraph
oWord.Selection.TypeText("Starting second table.") ; Just what is to be expected.
oWord.Selection.TypeParagraph
range2 := oWord.Selection.Range
; Set Range - this was at the heart of the problem
; reported by OP
oWord.ActiveDocument.tables.Add(range2,11,5)
; Add another table in range
oWord.Selection.Tables(1).Style := "Table Grid"
; set style
oWord.Selection.Tables(1).Cell(2,2).Range.Select
; select a cell (would be "B2" if this were Excel)
oWord.Selection.TypeText("B2")
; type identifying text in selected cell
oWord.Selection.MoveDown(5, 12, 0)
; wdLine := 5, Count has no constant. wdMove is 0, wdExtend is 1
oWord.Selection.TypeText("End of table demonstration")
Thank you for everyone for trying to give solution for this question. I could able to figure out one idea two hours after posting this question. I had to add
oWord.Selection.MoveDown(5,1)
before
oWord.Selection.EndKey
and modify
oWord.ActiveDocument.tables.Add(oWord.Selection.Range,5,5)
instead
oWord.ActiveDocument.tables.Add(range,5,5)
and removed second
range := oWord.ActiveDocument.Range(0, 0)
Related
I wrote a VBA macro in MSP to insert a column (TaskColumn Flag20) to display specific indicator. It works well except that it creates the column each time I open the project file. Hence I am looking for a way to check if the column exists and is visible when opening file. I couldn't find any information on such possibility.
Many thanks beforehand.
Here's a way to get all of the visible columns programmatically
'The function returns all of the visible column names as a delimiter separated string.
' Call with a string as the first parameter to represent a custom delimiter, or leave
' blank to use the default of a comma ,
Function GetColumns(Optional customDelimeter As String) As String
If customDelimeter = "" Then customDelimeter = "," 'handle custom delimeter
Dim viewableColumns As String 'create return value
SelectRow Row:=1, RowRelative:=False 'select the 1st row then parse all columns composing that row
For Each lngFieldID In MSProject.ActiveSelection.FieldIDList
Dim columnName As String
If lngFieldID > 0 Then
'convert the column ID to a string of the field name, either custom or built-in
columnName = Trim((CustomFieldGetName(lngFieldID)))
If Len(columnName) = 0 Then
columnName = Trim(FieldConstantToFieldName(lngFieldID)) ' use the built-in field name
End If
'append return value
viewableColumns = viewableColumns & customDelimeter & columnName
End If
Next
'get rid of the first delimeter
If Len(viewableColumns) > 0 Then
viewableColumns = Right(viewableColumns, Len(viewableColumns) - 1)
End If
GetColumns = viewableColumns
End Function
A better idea might be to create/edit a specific view with a custom table that includes the columns you want. Then you don't have to check anything, just choose that view and it will always give you what you want.
If you want to automate showing the view then write a macro that uses the Application.ViewApplyEx method.
Final working code, thanks to Jerred S.
Public Sub CheckFlag20Column()
SelectRow Row:=1, RowRelative:=False 'select the 1st row then parse all columns composing that row
For Each lngFieldID In MSProject.ActiveSelection.FieldIDList
Dim columnName As String
If lngFieldID > 0 Then
columnName = Trim(FieldConstantToFieldName(lngFieldID)) ' use the built-in field name
If columnName = "Flag20" Then
SelectTaskColumn Column:="Flag20"
ColumnDelete
End If
End If
Next
End Sub
If the interest is in testing a single column, try this.
Works for either its constant name or the user assigned custom name.
Public Function IsColumnVisible(Name As String)
IsColumnVisible = False
On Error GoTo LeaveIsColumnVisible
SelectTaskColumn Column:=Name ' Will error out if the column is hidden
IsColumnVisible = True
LeaveIsColumnVisible:
End Function
I'm creating a database on Excel, and encountered some problems as I tried to assign auto number to each row.
Requirements are:
generate auto number to each row(on the column A) when column B is not blank.
the number should be unique and must always be connected to the contents of the same row even when the column is sorted or when new rows are inserted, etc.
when a new row is inserted (anywhere on the same column), a new number should be assigned (the newest number should be the biggest number)
if
possible, the auto number should have a prefix, and number should be displayed in four digits (e.g. 0001, 0011)
I have tried some VBA codes I found from other people's questions (e.g. Excel VBA : Auto Generating Unique Number for each row).
So far, the code below has worked the best, but the requirement (3) and (4) couldn't be solved by that code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
I'm short of the knowledge of VBA and I hope someone could help me this.
Many thanks.
Alternative via CustomDocumentProperties
Instead of using a hidden sheet as proposed by #TimWilliams, one can assign incremented values to a user defined custom document property (CDP), naming it e.g. "InvNo" holding the newest invoice number. The cdp remain stored in the saved workbook.
The function below gets the current number saved to this workbook related property and returns the next number by adding 1 to the current value. It uses a help procedure RefreshCDP to assign the new value (could be used of course independantly to reset values programmaticaly to any other value). - If the cdp name isn't passed as (optional) argument, the function assumes "InvNo" by default.
Note that code requires some error handling to check if the cdp exists.
Example call
Dim InvoiceNumber as Long
InvoiceNumber = NextNumber("InvNo") ' or simply: NextNumber
Public Function NextNumber(Optional CDPName As String = "InvNo") As Long
'a) get current cdp value
Dim curVal As Long
On Error Resume Next
curVal = ThisWorkbook.CustomDocumentProperties(CDPName)
If Err.Number <> 0 Then Err.Clear ' not yet existing, results in curVal of 0
'b) increment current cdp value by one to simulate new value
Dim newVal As Long
newVal = curVal + 1
'Debug.Print "Next " & CDPName & " will be: " & newVal
'c) assign new value to custom document property
RefreshCDP CDPName, newVal, msoPropertyTypeNumber
'Debug.Print "New " & CDPName & " now is: " & ThisWorkbook.CustomDocumentProperties(CDPName)
NextNumber = newVal
End Function
Help procedure RefreshCDP
Sub RefreshCDP(CDPName As String, _
newVal As Variant, docType As Office.MsoDocProperties)
On Error Resume Next
ThisWorkbook.CustomDocumentProperties(CDPName).Value = newVal
'If cdp doesn't exist yet, create it (plus adding the new value)
If Err.Number > 0 Then
ThisWorkbook.CustomDocumentProperties.Add _
Name:=CDPName, _
LinkToContent:=False, _
Type:=docType, _
Value:=newVal
End If
End Sub
Related links
MS help: Excel.Workbook.CustomDocumentProperties
Check if BuiltInDocumentProperty is set without error trapping
Chip Pearson: Document Properties
How to add a DocumentProperty to CustomDocumentProperties in Excel?
Do not use Max() to find the next number - use instead a hidden sheet or name to store the current number, and increment it each time a new Id is required.
For example:
Public Function NextNumber(SequenceName As String)
Dim n As Name, v
On Error Resume Next
Set n = ThisWorkbook.Names(SequenceName)
On Error GoTo 0
If n Is Nothing Then
'create the name if it doesn't exist
ThisWorkbook.Names.Add SequenceName, RefersTo:=2
v = 1
Else
'increment the current value
v = Replace(n.RefersTo, "=", "")
n.RefersTo = v + 1
End If
NextNumber = v
End Function
This allows you to use multiple different sequences as long as you give each one a distinct name.
Dim seq
seq = NextNumber("seqOne")
'etc
Dim chr As Range
test = 1
For Each chr In ActiveDocument.Range.Characters
Dim firstChar As Word.Range
Set firstChar = Selection.Characters(test)
MsgBox (Selection.Characters(test))
MsgBox (test)
test = test + 1
Next chr
This is supposed to select the first character and then later do something with it , and move to the second character, that part isn't happening as the value of "test" is not increasing , and the macro gives an error of :"the requested collection doesn't exist"
Why isn't the value incrementing .
Well, it works on the Selection. If you don't select any text, it will give you the mentioned error. But why overcomplicate it? This code does what you (seem to) want:
Dim chr As Range
For Each chr In Selection.Characters
MsgBox chr.Text
Next chr
I have a document which is separated by section breaks.
Within each section I may have zero or one column breaks.
I want to extract the text from the first column of each section that contains 2 columns, like so:
For Each oSec In ActiveDocument.Sections
iSectionStart = oSec.Range.Start
iSectionEnd = oSec.Range.End
i = oSec.PageSetup.TextColumns.Count
If (2 = i) Then
' Update the range to only contain the text in textcolumn 1
' then select and copy it to a destination string
End If
Next oSec
However, the TextColumns object does not seem to have a method for returning the column contents.
TextColums.Count is actually not specified by the number of Column Breaks. You can have 2 columns (i.e. TextColumns.Count = 2) without a single Column Break.
If you for instance create a new document, fill it with random text by typing
=Rand(100)
and hit enter and select Two Columns from the Layout Tab. You will notice that you get two columns over 8 pages or so where none of the pages have Column Breaks.
The Office Object Model does not provide with an option to automatically select a specific column on a specifice page within a section. If the document actually has Column Breaks you can use the Find option to find the Column Break and from there select the Range from the start of the page to the start of the Column Break character that you just found using the Find option. Not a trivial thing to do as you can see.
Since the column break marker is represented by the ASCII value 14, all I had to do was look at each word in the section until I found the expected marker
Sub ExtractColumnText()
'
' On pages with no columns, the text is copied to both output files
' On pages with two columns, the column1 text is copied to "C:\DocTemp\Italian.doc"
' and column2 text is copied to "C:\DocTemp\English.doc"
'
Dim DestFileNum1 As Long
Dim DestFileNum2 As Long
Dim strDestFile1 As String
Dim strDestFile2 As String
Dim strCol1 As String
Dim strCol2 As String
Dim i As Integer
Dim oSec As Section
Dim oRngCol1 As Range
Dim oRngCol2 As Range
Dim oRngWord As Range
strDestFile1 = "C:\DocTemp\Italian.doc" 'Location of external file
DestFileNum1 = FreeFile()
strDestFile2 = "C:\DocTemp\English.doc" 'Location of external file
DestFileNum2 = DestFileNum1 + 1
Open strDestFile1 For Output As DestFileNum1
Open strDestFile2 For Output As DestFileNum2
For Each oSec In ActiveDocument.Sections
Set rngWorking = oSec.Range.Duplicate
Set oRngCol1 = rngWorking.Duplicate
oRngCol1.End = rngWorking.End - 1 ' exclude the page break
Set oRngCol2 = oRngCol1.Duplicate
If 2 <= oSec.PageSetup.TextColumns.Count Then
'examine each word in the section until we switch columns
For Each rngWord In rngWorking.Words
' 14 = column break marker
If 14 = AscW(rngWord.Text) Then
oRngCol1.End = rngWord.Start
oRngCol2.Start = rngWord.End
GoTo Xloop
End If
Next rngWord
End If
Xloop:
oRngCol1.Select
Print #DestFileNum1, oRngCol1.Text
oRngCol2.Select
Print #DestFileNum2, oRngCol2.Text
Next oSec
Close #DestFileNum1
Close #DestFileNum2
MsgBox "Done!"
End Sub
Writing a macro I found out that I need to skip the table contents and place my cursor right after that, for this I am using a code as
Selection.Tables(cnt).Select
Selection.Collapse WdCollapseDirection.wdCollapseEnd
Here, cnt is a counter value which increases each time a table is found, but if run the macro in selective pages then how will i know the number of nth table inside which my cursor is.
Important! This solution allows you to find the number of currently selected table within document.
Add this function to any your Module:
Function WhichTableNo(RNG As Range)
If RNG.Tables.Count > 0 Then
Dim DOC As Document
Set DOC = RNG.Parent
Dim rngTMP As Range
Set rngTMP = DOC.Range(0, RNG.Tables(1).Range.End)
WhichTableNo = rngTMP.Tables.Count
Else
WhichTableNo = "Not in the table"
End If
End Function
and to check the table number you could call it this way:
debug.Print WhichTableNo(Selection.Range)
As a result you get number of table you are currently in.
The table in which your cursor is is always Selection.Tables(1).
If Selection.Tables.Count > 0 Then
Dim r As Range
Set r = Selection.Tables(1).Range
r.Collapse wdCollapseEnd
r.Select
End If
In case of nested tables, you might want to also check Selection.Tables.NestingLevel. The following will exit any number of nested tables, placing the cursor after the outermost table:
If Selection.Tables.Count > 0 Then
Dim r As Range, i As Long
Set r = Selection.Range
For i = 1 To r.Tables.NestingLevel
Set r = r.Tables(1).Range
r.Collapse wdCollapseEnd
Next
r.Select
End If