I have a word template ready with mail merge fields.
Is there a easy way to convert them into fillable form fields?
In the end I want to create a fillable pdf form.
If it's a simple legacy field:
Public Sub ReplaceMergeFields()
On Error GoTo MyErrorHandler
Dim sourceDocument As Document
Set sourceDocument = ActiveDocument
Dim myMergeField As Field
Dim i As Long
For i = sourceDocument.Fields.Count To 1 Step -1
Set myMergeField = sourceDocument.Fields(i)
myMergeField.Select
If myMergeField.Type = wdFieldMergeField Then
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
End If
DoEvents
Next
Exit Sub
MyErrorHandler:
MsgBox "ReplaceMergeFields" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
Related
Taken dis codes from random sites using for extract the text content in Slide and Notes section from PPT slides. But the output file given as a NOTEPAD. I want the o/p file as a word document. Can anyone to help on this? Thanks to you in advance
P.S. I express my gratitude those who created these codes and simplify my work.
Option Explicit
Sub ExportNotesText()
Dim oSlides As Slides
Dim oSl As Slide
Dim oSh As Shape
Dim strNotesText As String
Dim strFileName As String
Dim intFileNum As Integer
Dim lngReturn As Long
' Get a filename to store the collected text
strFileName = InputBox("Enter the full path and name of file to extract notes text to", "Output file?")
' did user cancel?
If strFileName = "" Then
Exit Sub
End If
' is the path valid? crude but effective test: try to create the file.
intFileNum = FreeFile()
On Error Resume Next
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then ' we have a problem
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _ & "Please try again."
Exit Sub
End If
Close #intFileNum ' temporarily
' Get the notes text
Set oSlides = ActivePresentation.Slides
For Each oSl In oSlides
strNotesText = strNotesText & "======================================" & vbCrLf
strNotesText = strNotesText & "Slide" & oSl.SlideIndex & vbCrLf
strNotesText = strNotesText & SlideText(oSl) & vbCrLf
strNotesText = strNotesText & NotesText(oSl) & vbCrLf
Next oSl
' now write the text to file
Open strFileName For Output As intFileNum
Print #intFileNum, strNotesText
Close #intFileNum
' show what we've done
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)
End Sub
Function SlideText(oSl As Slide) As String
Dim oSh As Shape
Dim osld As Slide
Dim strNotesText As String
For Each oSh In oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
SlideText = SlideText & oSh.Name & ":" & " " & oSh.TextFrame.TextRange & vbCrLf
End If
End If
Next oSh
End Function
Function NotesText(oSl As Slide) As String
Dim oSh As Shape
For Each oSh In oSl.NotesPage.Shapes
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
NotesText = oSh.TextFrame.TextRange.Text
End If
End If
End If
Next oSh
End Function
For Example:
Sub Demo()
'Note: A VBA Reference to Word is required.
'See under Tools|References
Dim WdApp As New Word.Application, wdDoc As Word.Document
Dim Sld As Slide, Shp As Shape
Set wdDoc = WdApp.Documents.Add
For Each Sld In ActivePresentation.Slides
With Sld
For Each Shp In .NotesPage.Shapes
With Shp
If .PlaceholderFormat.Type = ppPlaceholderBody Then
If .HasTextFrame Then
If .TextFrame.HasText Then
wdDoc.Range.InsertAfter vbCr & Sld.SlideIndex & ": " & .TextFrame.TextRange.Text
End If
End If
End If
End With
Next
For Each Shp In .Shapes
With Shp
If .HasTextFrame Then
If .TextFrame.HasText Then
wdDoc.Range.InsertAfter vbCr & .Name & ": " & .TextFrame.TextRange.Text
End If
End If
End With
Next
End With
Next
WdApp.Visible = True: wdDoc.Activate
Set wdDoc = Nothing: Set WdApp = Nothing
End Sub
I have this code from another website but it's not working.
I want to filter the split view form from another form.
Private Sub btnSearch_Click()
'//Check that other form is loaded - if not, then open it
If Not fIsLoaded("frmMain") Then
DoCmd.OpenForm ("frmMain")
End If
'//Set filter to listbox criterion
Forms("frmMain").Filter = "[Priorities] = " & Chr(34) & Me.Priorities & Chr(34)
Forms("frmMain").FilterOn = True
End Sub
Function fIsLoaded(ByVal strFormname As String) As Boolean
'Returns False if form is not open or True if Open
If SysCmd(acSysCmdGetObjectState, acForm, strFormname) <> 0 Then
If Forms(strFormname).CurrentView <> 0 Then
fIsLoaded = True
End If
End If
End Function
I received this error
My best guess is the form wasn't ready to take a filter yet, and that's why the error occurred. DoCmd.OpenForm takes a Where argument to set the filter when opening to prevent this from occuring.
Private Sub btnSearch_Click()
'//Check that other form is loaded - if not, then open it with the filter
If Not fIsLoaded("frmMain") Then
DoCmd.OpenForm ("frmMain",,,"[Priorities] = " & Chr(34) & Me.Priorities & Chr(34))
Else
'//Set filter to listbox criterion
Forms("frmMain").Filter = "[Priorities] = " & Chr(34) & Me.Priorities & Chr(34)
Forms("frmMain").FilterOn = True
End If
End Sub
Check if this works. If not, your filter might not be valid for that form.
I have developed a split form which uses the following record source:
SELECT * FROM [CCG Complaints];
The form works well and I have no problems with that side of things.
Users have two buttons: one to search, and one to show all records.
The problems arise when, after performing a search, I close the form and then reopen it again (in form view):
However, whenever I click Show all before closing the form, it opens successfully in form view with no errors.
Another feature is that, after receiving the error mentioned above, I am able to open the form in design view, and can then view it in form view without the error message - the error only occurs when the form is opened in form view in the first instance.
Why is this and what can I do to rectify it?
The code I use for the buttons is here:
Private Sub search_Click()
Dim strSearch As String
Dim strText As String
If Len(Me.txtSearch.Value & vbNullString) = 0 Then
MsgBox ("Enter a search term.")
Else
strText = Me.txtSearch.Value
strSearch = "SELECT* from [CCG Complaints] where [Ref no] Like ""*" & strText & "*"" or [lastName] Like ""*" & strText & "*"" Or CCG Like ""*" & strText & "*"" "
Me.RecordSource = strSearch
End If
End Sub
Private Sub showAll_Click()
Dim strSearch As String
strSearch = "SELECT * from [CCG Complaints]"
Me.RecordSource = strSearch
End Sub
Instead of changing the recordsource, apply a filter to the existing records.
Me.filter = "[Ref no] Like ""*" & strText & "*"" or [lastName] Like ""*" & strText & "*"" Or CCG Like ""*" & strText & "*"" "
Me.FilterOn = True
Then Reset
Me.Filter = ""
Me.FilterOn = False
Be aware that if your record set gets even slightly large, this wildcard searching on lots of fields will become very inefficient. You might want to look at a more robust search method. This http://allenbrowne.com/ser-62.html is a more complete solution.
I suggest to set the RecordSource to [CCG Complaints], and not change it.
Instead use the .Filter properties, this is the usual way to implement a form filter:
Private Sub search_Click()
Dim strSearch As String
Dim strText As String
If Len(Me.txtSearch.Value & vbNullString) = 0 Then
MsgBox ("Enter a search term.")
Else
strText = Me.txtSearch.Value
strSearch = "[Ref no] Like ""*" & strText & "*"" or [lastName] Like ""*" & strText & "*"" Or CCG Like ""*" & strText & "*"" "
Me.Filter = strSearch
Me.FilterOn = True
End If
End Sub
Private Sub showAll_Click()
Me.Filter = ""
Me.FilterOn = False
End Sub
I have a form myForm with a text box myText.
In the onLoad function, I have written code that is supposed to append all the rows from a recordset, a database's lockfile, into the myText text box.
What actually happens is, only the first field of four fields is appended into the textbox.
Dim cn As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=Z:\myDatabase.mdb"
cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=Z:\myDatabase.mdb"
Set rs = cn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
Me.myText.SetFocus
Me.myText.text = ""
Do While Not rs.EOF
Me.myText.text = Me.myText.text & rs.Fields(0) & vbTab & rs.Fields(1) & vbTab & _
rs.Fields(2) & vbTab & rs.Fields(3) & vbCrLf
rs.MoveNext
Loop
I tried
Debug.Print rs.Fields(0) & vbTab & rs.Fields(1) & vbTab & rs.Fields(2) & vbTab & rs.Fields(3)
and all four fields showed in the immediate window.
EDIT:
I took out the vbtab, since it's not supported and the file itself already has spaces, and I changed Me.myText.text in
Me.myText.text = Me.myText.text & rs.Fields(0) & rs.Fields(1) & _
rs.Fields(2) & rs.Fields(3) & vbCrLf
to Me.myText.
Now my code seems to work in the beginning. When I debug step by step the text box fills like it's supposed to, but when Code exits the do while loop, only the first field of the first row shows in the text box.
debug.print Me.myText before exiting the loop shows all the rows. After exiting the loop still shows all the rows. But in the form, the textbox is only showing the first record, first field.
The form and the textbox both do not have any events other than this event, which is on the forms load.
What is wrong?
Use the property .Value (which is the default property for textbox) , not .Text
so Me.myText.Text ==> Me.myText.Value or Me.myText
The textbox support multi line with vbCrLf.
tab with vbTab is not supported
define myvbTab= " " as a tab separator instead of vbTab
Modify the following fragment of your code:
myvbTab= " "
dim row_data
Do While Not rs.EOF
row_data = rs.Fields(0) & myvbTab& rs.Fields(1) & _
myvbTab & rs.Fields(2) & myvbTab& rs.Fields(3) & vbCrLf
Me.myText= Me.myText & row_data
' be sure that data is displayed, to know if control characters in row_data
Debug.Print row_data
rs.MoveNext
Loop
Edit:
To isolate the problem can you run that code:(independent of reading recordset)
Me.myText.Value = "start "
Dim tabChar As String
tabChar = Chr(9) '" "
Me.myText = Me.myText & "one" & tabChar & "two" & vbCrLf
Me.myText = Me.myText & "three" & tabChar & "four" & vbCrLf
it should display
start one two
three four
I am struggling with the above error when trying to write the Visual Basic code for a 2010 Access Form. I am trying to get ensure that the associate and the Team Lead get the same email. When I first wrote the code, it worked initially. I have since added an "issue date" to the form, but not to the email. I attempted to add the issue date to the Script, but that did not work. I have since removed both the issue date from the form and the script. Any help would appreciated:
Private Sub cmdEmail_Click()
Dim objOutlook As Object
Dim objMailItem As Object
Const olMailItem As Integer = 0
Dim objMailItem1 As Object
Const olMailItem1 As Integer = 0
Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(olMailItem)
Set objMailItem1 = objOutlook.CreateItem(olMailItem1)
Dim strPathAttach As String
On Error GoTo err_Error_handler
'set receipient, you can use a DLookup() to retrieve your associate Email address
objMailItem.To = DLookup("Email_ID", "dbo_Noble_Associates", "[Fullname]='" & Me.cboAssociate & "'")
objMailItem1.To = DLookup("Email_ID", "dbo_TeamLeads$", "[Fullname]='" & Me.txtTeamLead & "'")
'set subject with text and Form values
objMailItem.Subject = "Attendance Violation " & Me.cboAssociate
objMailItem1.Subject = "Attendance Violation " & Me.cboAssociate
'set body content with text and Form values etc.
objMailItem.htmlBody = "Date of Occurrence: " & Format(Me.Occurrence_Date, "mm/dd/yyyy") & "<br>" & "Attendance Points: " & Me.CboType & "<br>" & "Total Points: " & Me.txtTotalpoints & "<br>" & "Notes: " & Me.txtNotes
objMailItem1.htmlBody = "Date of Occurrence: " & Format(Me.Occurrence_Date, "mm/dd/yyyy") & "<br>" & "Attendance Points: " & Me.CboType & "<br>" & "Total Points: " & Me.txtTotalpoints & "<br>" & "Notes: " & Me.txtNotes
' display email
' objMailItem.Display
' sending mail automaticly
objMailItem.Send
objMailItem1.Send
Set objOutlook = Nothing
Set objMailItem = Nothing
Set objMailItem1 = Nothing
exit_Error_handler:
On Error Resume Next
Set objOutlook = Nothing
Set objMailItem = Nothing
Set objMailItem1 = Nothing
Exit Sub
err_Error_handler:
Select Case Err.Number
'trap error 287
Case 287
MsgBox "Canceled by user.", vbInformation
Case Else
MsgBox "Error " & Err.Number & " " & Err.Description
End Select
Resume exit_Error_handler
End Sub
Private Sub CheckEmail_Click()
End Sub
Private Sub cmdSaveandNew_Click()
If Me.txtOccurrence_Date & "" = "" Then
MsgBox "Please enter the date."
Me.txtOccurrence_Date.SetFocus
Exit Sub
ElseIf Me.cboAssociate & "" = "" Then
MsgBox "Please select the associate's name."
Me.cboAssociate.SetFocus
Exit Sub
ElseIf Me.txtPoints & "" = "" Then
MsgBox "Please enter the number of Points."
Me.txtPoints.SetFocus
Exit Sub
End If
If Me.CheckEmail = True Then
cmdEmail_Click
End If
DoCmd.Close acForm, Me.Name
End Sub
Private Sub cmd_Cancel_Click()
Me.Undo
DoCmd.Close acForm, Me.Name
End Sub
Private Sub cboassociate_AfterUpdate()
Me.txtTeamLead.Value = Me.cboAssociate.Column(1)
End Sub
Private Sub cboFullname_AfterUpdate()
Me.txtCurrentpoints.Value = Me.cbofullname.Column(1)
End Sub
Private Sub CboType_AfterUpdate()
Me.txtPoints.Value = Me.CboType.Column(1)
End Sub
I am open to any suggestions.