With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "{OPTION %1}"
.StartAt = 1
.LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
This code changes the style of lists from %1. to {OPTION %1}. I would need to keep my cursor on the existing list to run the code successfully,
Is it possible to iterate through all the pages, find the existing lists and automatically change it? I was unable to use the normal Replace feature either as it was part of the list.
Related
I'm somewhat inexperienced with VBA coding and need help inserting an object into an Excel spreadsheet based on a cell reference.
What I need to be able to do is pull a PDF in as an object icon based on another cell's contents, overlay it over a specific cell and then move down a row to repeat indefinitely until a blank cell occurs.
One problem with this is that the item number in column A may not have a corresponding file that matches it in my file directory, so I need for the code to run regardless of an error in the search for the PDF. Here's an example of the layout of my sheet. Spreadsheet Example
Here's the small bit of code that I have cobbled together already, however I'm not confident that it's even remotely usable.
Dim varItem
Sub Insert_PDF_Object()
Range("A2").Select
Do Until IsEmpty(ActiveCell)
varItem= ActiveCell.Offset(0, 0)
ActiveCell.Offset(0, 0).RowHeight = 80
Get_Object
ActiveCell.Offset(1, 0).Select
Loop
Range("A3").Select
End Sub
Sub Get_Object()
Worksheets("Sheet1").OLEObjects.Add Filename:="c:\Test\"&
Range("A2").Value & ".pdf", Link:=False, DisplayAsIcon:=True,
Left:=40, Top:=40, Width:=100, Height:=100
End Sub
Any help anyone can provide would really be great!
Try this.
Note if you want to use DisplayAsIcon:=True then you need to supply the path to the icon file and the index.
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/oleobjects-add-method-excel
Sub Insert_PDF_Object()
Dim c As Range, fName
Set c = ActiveSheet.Range("A2")
Do While Len(c.Value) > 0
fName = "c:\_Stuff\Test\" & c.Value & ".pdf"
If Dir(fName, vbNormal) <> "" Then
c.RowHeight = 80
c.Worksheet.OLEObjects.Add Filename:=fName, Link:=False, _
DisplayAsIcon:=True, _
Left:=c.Offset(0, 1).Left, _
Top:=c.Offset(0, 1).Top, _
Width:=80, Height:=80
End If
Set c = c.Offset(1, 0)
Loop
End Sub
I am trying to insert a custom field (ProtocolNumber), created under Document Properties in Word, into a table cell with additional text around it. I'm not quite sure how to use the Fields.Add function in this case. Sorry if question is too basic, but I'm a total hacker in VBA.
NoOfCol = 5
Set tblNew = ActiveDocument.Tables.Add(Selection.Range, 9, NoOfCol,
wdAutoFitWindow)
With tblNew
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Columns(1).PreferredWidth = 100 * NoOfCol * 3 / (NoOfCol + 1)
End With
tblNew.Borders.InsideLineStyle = wdLineStyleSingle
tblNew.Borders.OutsideLineStyle = wdLineStyleSingle
tblNew.Cell(Row:=1, Column:=1).Merge _
MergeTo:=tblNew.Cell(Row:=1, Column:=NoOfCol)
tblNew.Cell(1, 1).Split NumColumns:=2
tblNew.Cell(1, 1).Range.Text = "PROTOCOL: [ProtocolNumber]" & vbCrLf & "DRUG/INDICATION:
:
:
This is the code you might be looking for.
Dim Rng As Range
Dim PropName As String
Set Rng = tblNew,Cell(1, 1).Range
Rng.Collapse wdCollapseStart ' insert field at start of cell
PropName = "Protocol number" ' Custom document property by this name must exist
Rng.Fields.Add Range:=Rng, _
Type:=wdFieldEmpty, _
Text:="DOCPROPERTY """ & PropName & """", _
PreserveFormatting:=True
Note that Word will not be able to access the columns in your table after you do any horizontal merging. Similarly, the ability to access rows will be lost when any cells are merged vertically. In a nutshell, merging cells in a table is not a good idea, and if you absolutely must do it then do it after you are done accessing the cells.
This question already has answers here:
Create data validation list when some of the values have commas?
(4 answers)
Closed 7 years ago.
i am trying to create a data validation list using vba code. The array generate itself depending on many variable.
here is the code i am using
For iter4 = 2 To nbWsheet
If Wsheet.Cells(iter4, 2) = Cat And Wsheet.Cells(iter4, ColMod) = "x" And Wsheet.Cells(iter4, ColStd) = "oui" Then
TableValue = Wsheet.Cells(iter4, 4).Value & " - " & Wsheet.Cells(iter4, 7).Value
Table = Table & "," & TableValue
End If
Next iter4
'Ajout de la list
With Cells(iGlob, 5).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Table
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = ""
.ShowError = ""
End With
The problem with this code, is the text in the table contain ",". When the data validation list is generated, every time it see a "," it put the text on a new line...
Is there a way to keep the "," inside the table
Exemple of what i want to display : 123456 - Engine, 300HP
Hope i was clear,
Thanks,
I don't think there is an escape character for the comma in custom list. According to MSDN Validation.Add, the comma always separate the entries.
One workaround is to use Dynamic Named Range.
Use a spare column in a hidden sheet or somewhere, lets use Column A for demo
In A1, put in "DV_ListTable", Define the cell with name DV_ListTable
Highlight Column A, Define it as DV_ListColumn
Define another name using Name Manager as DV_List with RefersTo as
=OFFSET(DV_ListTable,1,0,IF(COUNTA(DV_ListColumn)-1=0,1,COUNTA(DV_ListColumn)-1))
Now the Data Validation will be (cell D1):
Then the macro to change this dynamic range contents will be:
Option Explicit
Sub ChangeDataValidationList()
Dim i As Long, Table As String, TableValue As String
Dim oRng As Range, oValues As Variant
With ThisWorkbook
' Build up the new table list
Table = .Names("DV_ListTable").RefersToRange.Value ' Header
' For Demo, the data is from Columns next to the DV_ListTable
Set oRng = .Names("DV_ListTable").RefersToRange.Offset(0, 1)
Do Until IsEmpty(oRng)
TableValue = oRng.Value & " - " & oRng.Offset(0, 1).Value
Table = Table & vbCrLf & TableValue
Set oRng = oRng.Offset(1, 0)
Loop
Set oRng = Nothing
' Clear the contents in the column
.Names("DV_ListColumn").RefersToRange.ClearContents
' Paste in the values separated by vbCrLf
oValues = Application.Transpose(Split(Table, vbCrLf))
.Names("DV_ListTable").RefersToRange.Resize(UBound(oValues)) = oValues
Set oValues = Nothing
End With
End Sub
Sample screenshot after "ChangeDataValisationList" executed:
Hope this helps you on the right direction for a work around.
Replace "," with Chr(44). The Chr function returns a string based on the VBA character code. I find it also comes in handy when you want to insert a double-quote (Chr(34) for a double quote).
I have posted this problem before, however, I think it was overly complicated and I didn’t explain it very well. This time I am just using a simple UserForm as an example.
I want to populate a ListBox by entering search criteria in a Textbox.
I have three columns:
Column A = Library Card Number
Column B = Pupil Name
Column C = Book Reference
I have a UserForm:
TextBox = txtlcn (for the Library Card Number)
TextBox = txtpn (for the Pupil Name)
TextBox = txtbr (for the Book Reference)
Command Button = cmdfinddetails (Find Details)
What I want to do is change the TextBox ‘txtbr’ into a ListBox, so that I can see if a pupil has more than one book loaned out to them. The process would be:
A pupil enters their Library Card Number in TextBox ‘txtlcn’ and
clicks on Command Button ‘cmdfinddetails’
The code will search for that Pupil’s name and all the book
references booked out to them.
The book reference(s) will be displayed in a ListBox.
I have tried lots of things to do with RowSource but it always lists every pupil’s book reference. Below is my sample code.
Private Sub cmdfinddetails_Click()
Set xSht = Sheets("Library")
Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = txtlcn.Text
Set aCell = xSht.Range("A1:A" & Lastrow).Find
(What:=strSearch, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing And txtpn.Value = "" Then
GoTo libcardrefvalid
Else
MsgBox "Oops! That Library Card does not exist. Please try again.", Title:="We LOVE Reading ;-)"
txtlcn.Value = ""
End If
Exit Sub
libcardrefvalid:
row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("Library").Range("A" & row_number)
If item_in_review = txtlcn.Text Then
txtpn.Text = Sheets("Library").Range("B" & row_number)
txtbr.Text = Sheets("Library").Range("C" & row_number)
End If
Loop Until item_in_review = ""
End Sub
Any help would be greatly appreciated.
Thank you.
Assuming that you have already changed txtbr to a listbox, I was able to get your code working (looking up pupil name and adding all books referenced to the txtbr listbox) with the following additions:
Private Sub CommandButton1_Click()
'clears the pupil name (caused an error if not done)
txtpn.Text = ""
Set xSht = Sheets("Library")
Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = txtlcn.Text
Set aCell = xSht.Range("A1:A" & Lastrow).Find(What:=strSearch, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing And txtpn.Value = "" Then
GoTo libcardrefvalid
Else
MsgBox "Oops! That Library Card does not exist. Please try again.", Title:="We LOVE Reading ;-)"
txtlcn.Value = ""
End If
Exit Sub
libcardrefvalid:
row_number = 0
'clears the listbox so that you have dont have a continuously growing list
txtbr.Clear
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("Library").Range("A" & row_number)
If item_in_review = txtlcn.Text Then
txtpn.Text = Sheets("Library").Range("B" & row_number)
'Adds the book reference number to the list box
txtbr.AddItem Sheets("Library").Range("C" & row_number)
End If
Loop Until item_in_review = ""
End Sub
I made a test userform and some mock up data and this worked for me. Hopefully you find it does so for you as well.
i'm developing a application that load data from DB to an excel sheet.
And in one of these columns, I need to sort in a DESCENDING form.
But I just cant do this, because all the time this give me errors...
In the ascending form (default) I can do it and it passes without any trouble, but when I try to put the parameter of the descending, this don't pass it.
EDIT*
First, declarations and constants:
Dim obj_excel As Object
Set obj_excel = CreateObject("Excel.Application")
Dim oSheet As Object ' Worksheet
Dim oChart As Object ' To declare chart Excel
obj_excel.Workbooks.Add 'add a workbook to the app
obj_excel.Sheets(w_Plan1).Select
obj_excel.Sheets("Folha2").Name = "Provider"
obj_excel.cells(1, w_coluna).Font.Bold = True
'header
obj_excel.cells(1, w_coluna).Font.Size = 10
obj_excel.cells(1, w_coluna).Value = "OF"
obj_excel.cells(1, w_coluna).HorizontalAlignment = -4108
'Assigning values to one cell
obj_excel.cells(w_linha, 2).Font.Bold = False
obj_excel.cells(w_linha, 2).Font.Size = 10
obj_excel.cells(w_linha, 2).Value = obj_cmpcil0.H_cdforneced1
obj_excel.cells(w_linha, 2).HorizontalAlignment = -4108
...
.....
......
'Creating a chart
Set oSheet = obj_excel.worksheets.Item(2)
Set oChart = oSheet.ChartObjects.Add(250, 10, 660, 450).Chart
oChart.SetSourceData Source:=oSheet.Range(w_Plan2 & "!$A$1:$C$11")
Of course there is a lot more code... but I just put here fragments of code and the chart built like example to you see how my code is organized and declared..
*FINISH EDIT
the ascending form that my code works:
obj_excel.Sheets(2).Range("A2:C25").Sort _
key1:=obj_excel.Sheets(2).Columns("C")
the form that I tryng to add the descending Parameter:
obj_excel.Sheets(2).Range("A2:C25").Sort _
key1:=obj_excel.Sheets(2).Columns("C") _
Order1:=xlDescending, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
the parameters of method sort, isnt it all optional?
Using actual values instead of Excel-defined xlXXXXconstants:
With obj_excel.Sheets(2)
.Range("A2:C25").Sort key1:=.Columns("C"), _
Order1:=2, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=1, _
DataOption1:=0
End With