I've looked at the documentation for table cell objects and selection objects in VBA, and I didn't see any way to delete cell contents in Word while retaining the cell itself. It looks like doing so is easy in Excel, and next to impossible in Word.
Some cells I need to do this for will contain text, others will contain text form fields. Any ideas?
This works:
ActiveDocument.Tables(1).Cell(1, 2).Select
Selection.Delete
This deletes the cell contents but leaves the empty cell behind.
I understand your dismay, because oddly, the above does not do the same as
ActiveDocument.Tables(1).Cell(1, 2).Delete
which deletes the entire cell!
The former is the equivalent of selecting a cell and pressing the Delete key (which clears the contents but leaves the cell in place). The latter is the equivalent of right-clicking a cell and choosing "Delete cells..." (which deletes the cell).
I cobbled this together from various parts of the interwebs... including Fumei from VBA Express. It's working well. Select any cells in your table and run the macro deleteTableCells
Sub deleteTableCells()
Dim selectedRange As Range
On Error GoTo Errorhandler
Set selectedRange = SelectionInfo
selectedRange.Delete
Errorhandler:
Exit Sub
End Sub
Function SelectionInfo() As Range
'
Dim iSelectionRowEnd As Integer
Dim iSelectionRowStart As Integer
Dim iSelectionColumnEnd As Integer
Dim iSelectionColumnStart As Integer
Dim lngStart As Long
Dim lngEnd As Long
' Check if Selection IS in a table
' if not, exit Sub after message
If Selection.Information(wdWithInTable) = False Then
Err.Raise (2022)
Else
lngStart = Selection.Range.Start
lngEnd = Selection.Range.End
' get the numbers for the END of the selection range
iSelectionRowEnd = Selection.Information(wdEndOfRangeRowNumber)
iSelectionColumnEnd = Selection.Information(wdEndOfRangeColumnNumber)
' collapse the selection range
Selection.Collapse Direction:=wdCollapseStart
' get the numbers for the END of the selection range
' now of course the START of the previous selection
iSelectionRowStart = Selection.Information(wdEndOfRangeRowNumber)
iSelectionColumnStart = Selection.Information(wdEndOfRangeColumnNumber)
' RESELECT the same range
Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - lngStart
' set the range of cells for consumption
With ActiveDocument
Set SelectionInfo = .Range(Start:=.Tables(1).cell(iSelectionRowStart, iSelectionColumnStart).Range.Start, _
End:=.Tables(1).cell(iSelectionRowEnd, iSelectionColumnEnd).Range.End)
End With
End If
End Function
Sorry for digging up such an old question, but hopefully someone will find this useful. If you prefer to avoid the Select method, the following is what you're looking for:
ActiveDocument.Tables(1).Cell(1, 1).Range.Text = ""
It deletes images and content controls as well.
Private Sub cbClearTable_Click()
'mouse cursor must be in the table for clearing
Dim cell_BhBp As Cell
For Each cell_BhBp In Selection.Tables(1).Range.Cells
cell_BhBp.Range = ""
Next
End Sub
The code above clears the contents in all cells in the current table /the table, where the mouse cursor is/
One other way to clear all table cells of first table in document is
ActiveDocument.Tables(1).Range.Delete
Or for current table /where the cursor is in/
Selection.Tables(1).Range.Delete
Private Sub CommandButton40_Click()
Application.Activate
SendKeys ("{DEL}")
End Sub
The code above clears contents of all selected cells. In this case, the selected cells may not be adjacent. This code is fired when button of user form is clicked.
Related
Some logic to my process:
In column K on my worksheet I have inserted check boxes from cell K3 - K53 (this could become longer in the future) using the developer tab.
I then associated the check box with the same cell it is placed in.
I formatted the cells in this column by going to 'Format Cells', clicking on 'Custom' then typing in ';;;'. This was to HIDE the 'True/False' text from view.
My next step is to change the cell colour based on the text.
Note:
I have searched through a few forums and combined some code samples from them all, so I will not be able to reference the sources exactly, but below is what I have so far:
Code:
Sub Change_Cell_Colour()
Dim xName As Integer
Dim xChk As CheckBox
Dim rng As Range
Dim lRow As Long
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ActiveWorksheet.Range("K2:K" & lRow)
For Each xChk In ActiveSheet.CheckBoxes
xName = Right(xChk.Name, Len(xChk.Name) - 10)
If (Range(xChk.LinkedCell) = "True") Then
rng.Interior.ColorIndex = 6
Else
rng.Interior.ColorIndex = xlNone
End If
Next
End Sub
I keep getting an error on the line where I try to get the last row.
Code:
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Error:
Object Required
I am not even sure if the code I have will solve my issue, so any help solving the main issue highlighting a cell based on the check box being checked or not, will be greatly appreciated.
Here's a quick rewrite with LOTS of comments explaining:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Be explicit about which worksheet. Leaving it to "Activeworksheet" is going to cause problems
' as we aren't always sure which sheet is active...
'Also in this case we don't need to know the last row. We will iterate checkbox objects, not
' populate rows.
'lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
'Again... we don't need this. We just need to iterate all the checkboxes on the sheet
'Set rng = ActiveWorksheet.Range("K2:K" & lRow)
'This is good stuff right here, just change the ActiveSheet to something more explicit
' I've changed this to the tab named "Sheet1" for instance.
For Each xChk In Sheets("Sheet1").CheckBoxes
'Getting the name of the checkbox (but only the last 10 characters)
xName = Right(xChk.Name, Len(xChk.Name) - 10)
'We can check the linked cell's value, but we can also just check if the
' if the checkbox is checked... wouldn't that be easier?
'If (Range(xChk.LinkedCell) = "True") Then
If xChk.Value = 1 Then
'Now we can use the "LinkedCell", but it's a STRING not a RANGE, so we will have
' to treat it as the string name of a range to use it properly
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
Here's the barebones version just to get it working
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Loop through each checkbox in Sheet1. Set it to color 6 if true, otherwise no color
For Each xChk In Sheets("Sheet1").CheckBoxes
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
I'm totally assuming here, but I would imagine you want this macro to fire when a checkbox is clicked. There is a handy Application.Caller that holds the name of the object that caused a macro to be called. You can set the "Assign Macro.." of each checkbox to this new code and then you can figure out which checkbox called the subroutine/macro using application.caller and follow the same logic to toggle it's linked cell color:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Who called this subroutine/macro?
Dim clickedCheckbox As String
clickedCheckbox = Application.Caller
'Lets check just this checkbox
Set xChk = Sheets("Sheet1").CheckBoxes(clickedCheckbox)
'toggle its color or colour if you are a neighbour
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
End Sub
highlighting a cell based on the check box being checked or not
Select the sheet and apply a CF formula rule of:
=A1=TRUE
ActiveWorksheet doesn't exist, and because you haven't specified Option Explicit at the top of your module, VBA happily considers it an on-the-spot Variant variable.
Except, a Variant created on-the-spot doesn't have a subtype, so it's Variant/Empty.
And ActiveWorksheet.Cells being syntactically a member call, VBA understands it as such - so ActiveWorksheet must therefore be an object - but it's a Variant/Empty, hence, object required: the call is illegal unless ActiveWorksheet is an actual Worksheet object reference.
Specify Option Explicit at the top of the module. Declare all variables.
Then change ActiveWorksheet for ActiveSheet.
I want to copy a range of cell (values only/ text) to the clipboard so the user does not have to do a paste special values only when they paste them into another spreadsheet.
Here is what I have so far:
Private Sub CommandButton1_Click()
With New DataObject
.SetText Range("A32:Q32").Text
.PutInClipboard
End With
'Range("A32:Q32").Copy
End Sub
This gives me a runtime error
94 Invalid use of Null
If I just use the commented out code Range.("A32:Q32").Copy it copies the formulas and unless the user does the special paste they get all kinds of reference errors.
It's a bit convoluted, but get text > clear clipboard > put text back :
[A32:Q32].Copy
With New DataObject
.GetFromClipboard
s = .GetText
.Clear
.SetText s
.PutInClipboard
End With
Range.Text returns Null when the individual cell texts in the range are different.
I don’t know dataobject, so I propose a workaround by having the user select the destination cell, too
Private Sub CommandButton1_Click()
Dim userRng As Range
With ActiveSheet 'reference currently active sheet, before the user could change it via inputbox
Set userRange = GetUserRange()
If Not userRange Is Nothing Then ' if the user chose a valid range
With .Range("A32:Q32")
userRange.Resize(.Rows.Count, .Columns.Count).Value =.Value ' paste values only
End With
End If
End With
End Sub
Function GetUserRange() As Range
' adapted from http://spreadsheetpage.com/index.php/tip/pausing_a_macro_to_get_a_user_selected_range/
Prompt = "Select a cell for the output."
Title = "Select a cell"
' Display the Input Box
On Error Resume Next
Set GetUserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Range selection
' Was the Input Box canceled?
If GetUserRange Is Nothing Then MsgBox “Canceled!”
End Function
I have an open Word document with a bunch of bookmarks, each with an inline image of an Excel table previously exported from Excel.
Now, I need to update the tables in the Word document as they have changed in Excel.
The way I'm doing this is matching the table names in Excel with the bookmark names in Word. If they are equal than I want to replace the existing images in Word by the current ones.
This is my code so far:
Sub substituir()
Set WordApp = GetObject(class:="Word.Application")
Set DocumentoDestino = WordApp.ActiveDocument
For Each folha In ThisWorkbook.Worksheets
If folha.Visible Then
'loop all excel tables
For Each tabela In folha.ListObjects
tabela.Name = Replace(tabela.Name, " ", "")
nomeTabela = tabela.Name
For Each myBookmark In DocumentoDestino.Bookmarks
If Right(myBookmark.Name, 4) = "PGST" Then
'This is where I need help
If myBookmark.Name = nomeTabela Then
'code to clear the table already in myBookmark here
'then copy and paste tables in myBookmark
tabela.Range.Copy
myBookmark.Range.PasteSpecial link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End If
Next myBookmark
Next tabela
End If
Next folha
End Sub
I've tried lots of different approaches, from deleting the bookmark and adding it back again to others, but nothing seems to work.
In the comment: 'code to clear the table already in myBookmark here I need help.
In the following code, I have tried to include the syntax you might require for your project.
Private Sub TestMark()
Dim Mark As String
Dim Rng As Range
Dim ShpRng As Range
Mark = "Text1"
With ActiveDocument
If .Bookmarks.Exists(Mark) Then
Set Rng = .Bookmarks(Mark).Range
If Rng.InlineShapes.Count Then
Set ShpRng = Rng.InlineShapes(1).Range
With ShpRng
Debug.Print .Start, .End
End With
End If
End If
End With
End Sub
Of course once you know the Start and End of the range you can manipulate it, meaning delete and replace it.
It just occurs to me that you might use the InlineShape' Caption property to find and address it.
Say if you add a comment to a cell which includes the word "today", then we would like a VBA code to be tiggered to replace the "today" with today's date in that comment. But the problem here is that I could not find an event (or any other way) to know when a comment has been added, or to which cell (range object). Any ideas?
My current stupid solution is to add VBA code inside Worksheet_SelectionChange event (it's a shame that I could not get the old location before the selection change), and then do a For Each loop, check each comment in the sheet, then execute that replacement.
a workaround could be using a "helper" cell to store the address of the last selected cell so that once the user is done with the comment and selects another cell the event handler would check the "last" cell only
something like what follows (I used cell "A1" as "helper")
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cmt As Comment
With Target
If .Address <> Cells(1, 1) Then
Set cmt = Range(Cells(1, 1)).Comment
If Not cmt Is Nothing Then
With cmt
.Text (Replace(.Text, "today", Date))
End With
End If
End If
End With
Cells(1, 1) = Target.Address
End Sub
The address of the previously last clicked cell can conveniently be stored in a variable. The code below should be installed in the code sheet of the tab on which the action is expected. It will take note of the ActiveCell when the worksheet is activated and tracks every click thereafter. If there was a comment in the cell last clicked it will replace the word "today" with the current computer date.
Dim PrevCell As Range
Private Sub Worksheet_Activate()
Set PrevCell = ActiveCell ' last previously selected cell
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cmt As Comment
On Error GoTo NoPrevCell
' an error would occur if your code crashes for some
' unrelated reason and the sheet isn't activated
' before resuming work on the same sheet.
Set Cmt = PrevCell.Comment
If Not Cmt Is Nothing Then
With Cmt
.Text Replace(.Text, "today", Format(Date, "dd-mm-yy"), _
1, -1, vbTextCompare)
End With
End If
Set PrevCell = ActiveCell
Exit Sub
NoPrevCell:
Worksheet_Activate
Resume 0
End Sub
I think it's important for this application to have the Replace function recognize both lower and upper case "Today". This is achieved by specifying case-insensitivity in the function itself. I also prefer to have the date format set right here in the function rather than relying on a Short Date format determined in the setup for Windows.
I simply try to write a search macro in an excel sheet. How can I start a macro dynamically DURING editing a cell. When writing in a cell the search macro should run in the background with every character added or deleted not just at the end.
Worksheet_Change(ByVal Target As Range) only starts when editing is finished (return was hit or other cell was selected).
Thanks.
You can't. The code engine won't run while Excel is in Edit mode. You have to have the user enter the text in something other than a cell - like a control on the worksheet or a control on a userform.
Thanks to Dick Kusleika for answering my question and to put me on the right track.
Here is the final solution for anybody having similar demands. It basically works with an ActiveX TextBox to enter the search-string. The macro than is looking in the search-area for all entries containing the search-string. All other filled rows within the search-field will get hidden. This works right away when writing into the TextBox. So, when deleting characters in the search-string the once hidden rows will appear right away if appropriate.
Private Sub TextBox1_Change()
Dim searchArea As Range, searchRow As Range, searchCell As Range
Dim searchString As String
Dim lastRow As Integer
Application.ScreenUpdating = False
searchString = "*" & LCase(TextBox1.Value) & "*"
' unhide rows to have the full search field when editing
Rows.Hidden = False
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set searchArea = Me.Range("A5", "A" & lastRow) 'Me.Range("A5").End(xlDown))
searchArea.EntireRow.Hidden = True
For Each searchRow In searchArea.Rows
For Each searchCell In searchRow.Cells
If LCase(searchCell) Like searchString Then
searchRow.Hidden = False
Exit For
End If
Next searchCell
Next searchRow
Application.Goto Cells(1), True
Application.ScreenUpdating = True
End Sub
works like a charm.