slaughter131
05-13-2022, 01:58 PM
Hello Here is my automation code that is supposed to spit out a label based on a set of boundary conditions
It always automatically opens it up like this featured in the picture below
29738
I then have to click
1) "read mode" in the top left
2) "view"
3) "edit document"
in order to show the contained text in a viewable format
29739
Does anybody have any tips on how to make it formatted better from the start? I am thinking there must be a command to get it to save in a certain format but I can't seem to figure out what that is.
Any help is greatly appreciated as I have spent hours trying to resolve this issue.
Cheers
Below is the automation code
Public Sub Auto_Update(myDoc As Document, Optional JustDoIt As String, Optional DontSave As Boolean)
Dim HdrRange As Range
Dim tempCertNo As String
CALPath = "C:\Users\Calibration l\OneDrive - NTI Audio, Inc\Calibration\Shared Reference Certificate\"
ENVPath = "C:\Temp\"
'Set Variable equal to Header Range
Set HdrRange = myDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
'Check if this is the first time the file is open
myFlag = InStr(1, HdrRange, "FLAGTRUE") > 0
If myFlag = True Or JustDoIt = "DoIt" Then
'Call Replace(Selection, "mmm dd, yyyy", Format(Date, "mmmm dd, yyyy"))
Call SelFind("mmm dd, yyyy", Format(Date, "mmmm dd, yyyy"))
Call SelFind("mmm dd, yyy2", Format(DateAdd("yyyy", 1, Date), "mm/dd/yyyy"))
Call SelFind("mm/dd/yy", Format(Date, "mm/dd/yy"))
Call SelFind("mm/dd/y2", Format(DateAdd("yyyy", 1, Date), "mm/dd/yy"))
tempCertNo = NextCertNo(ENVPath + "CertNo.txt")
Call SelFind("CertNo", tempCertNo)
Call SelFind("Operator", (ENVPath + "Operator.docx"))
Call SelFind("OpInt", (ENVPath + "OperatorInt.docx"))
Call SelFind("#Mod", (ENVPath + "Model.docX"))
Call SelFind("FX100CAL", CALPath + "FX100 11375.docx")
Call SelFind("RefMicCAL", CALPath + "Reference Microphone 74048 S.docx")
'Check that the ENV sensor is acually writing
If Format(FileDateTime(ENVPath + "TempValue.txt"), "yy-mm-dd") = Format(Date, "yy-mm-dd") Then
Call SelFind("TempValue", ReadFile(ENVPath + "TempValue.txt"))
Call SelFind("HumValue", ReadFile(ENVPath + "HumValue.txt"))
Call SelFind("BPValue", Format(CDbl(ReadFile(ENVPath + "bpValue.txt")) / 10, "#.0"))
Else
MsgBox ("Environmental sensor data is old. Read the current values and manually enter")
End If
'Selection.InsertFile (CALPath + "FX100 11375.docx")
If JustDoIt <> "DoIt" Then
myDoc.SaveAs2 (tempCertNo & "-" & myDoc.Name)
End If
End If
'Set myFlag to FALSE, avoid change next time opened
With HdrRange.Find
.ClearFormatting
.Text = "FLAGTRUE"
.Replacement.ClearFormatting
.Replacement.Text = "FLAGFALSE"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
If DontSave = False Then myDoc.Save 'save the damn thing
End Sub
Private Sub SelFind(SearchText As String, ReplaceText As String)
' 08 Apr 2017
Dim Rng As Range
Dim Fnd As Boolean
'Selection.WholeStory
Selection.HomeKey Unit:=wdStory
Set Rng = Selection.Range
With Rng.Find
.ClearFormatting
.Execute FindText:=SearchText, Forward:=True, _
Format:=False, Wrap:=wdFindStop
Fnd = .Found
End With
If Fnd = True Then
With Rng
'.MoveStart wdWord, -2
.Select
End With
If InStr(1, ReplaceText, "\") Then
Selection.InsertFile (ReplaceText)
Else
'Rng.Text = ReplaceText
With Rng.Find
'.ClearFormatting
.Execute FindText:=SearchText, Forward:=True, _
Format:=False, Wrap:=wdFindStop
.Replacement.ClearFormatting
.Replacement.Text = ReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
End If
End If
End Sub
Function ReadFile(myFile As String) As String
Open myFile For Input As #1
Line Input #1, textline
ReadFile = textline
Close #1
End Function
Function NextCertNo(myFile As String) As Double
Dim CurrNo As String
Open myFile For Input As #1
Line Input #1, CurrNo
Close #1
NextCertNo = CDbl(CurrNo) + 1
Open myFile For Output As #1
Write #1, NextCertNo
Close #1
End Function
Sub junk()
'With Selection.Find.Text("FX100CAL")
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:="Line 2"
End With
Selection.Text = ""
Set Rng = myDoc.Sections.Item(1).Range
Rng.Collapse wdCollapseEnd
'With Selection.Find
'.ClearFormatting
'.Text = "FX100CAL"
'.Replacement.ClearFormatting
'.Replacement.Text = ""
'.Execute Replace:=wdReplaceAll, Forward:=True, _
'Wrap:=wdFindContinue
' End With
End Sub
Sub Replace(mySelection As Selection, SearchText As String, ReplaceText As String)
With mySelection.Find
.ClearFormatting
.Text = SearchText
.Replacement.ClearFormatting
'.Replacement.Text = Format(Date, "dd-mm-yyyy")
.Replacement.Text = ReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
End Sub
It always automatically opens it up like this featured in the picture below
29738
I then have to click
1) "read mode" in the top left
2) "view"
3) "edit document"
in order to show the contained text in a viewable format
29739
Does anybody have any tips on how to make it formatted better from the start? I am thinking there must be a command to get it to save in a certain format but I can't seem to figure out what that is.
Any help is greatly appreciated as I have spent hours trying to resolve this issue.
Cheers
Below is the automation code
Public Sub Auto_Update(myDoc As Document, Optional JustDoIt As String, Optional DontSave As Boolean)
Dim HdrRange As Range
Dim tempCertNo As String
CALPath = "C:\Users\Calibration l\OneDrive - NTI Audio, Inc\Calibration\Shared Reference Certificate\"
ENVPath = "C:\Temp\"
'Set Variable equal to Header Range
Set HdrRange = myDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
'Check if this is the first time the file is open
myFlag = InStr(1, HdrRange, "FLAGTRUE") > 0
If myFlag = True Or JustDoIt = "DoIt" Then
'Call Replace(Selection, "mmm dd, yyyy", Format(Date, "mmmm dd, yyyy"))
Call SelFind("mmm dd, yyyy", Format(Date, "mmmm dd, yyyy"))
Call SelFind("mmm dd, yyy2", Format(DateAdd("yyyy", 1, Date), "mm/dd/yyyy"))
Call SelFind("mm/dd/yy", Format(Date, "mm/dd/yy"))
Call SelFind("mm/dd/y2", Format(DateAdd("yyyy", 1, Date), "mm/dd/yy"))
tempCertNo = NextCertNo(ENVPath + "CertNo.txt")
Call SelFind("CertNo", tempCertNo)
Call SelFind("Operator", (ENVPath + "Operator.docx"))
Call SelFind("OpInt", (ENVPath + "OperatorInt.docx"))
Call SelFind("#Mod", (ENVPath + "Model.docX"))
Call SelFind("FX100CAL", CALPath + "FX100 11375.docx")
Call SelFind("RefMicCAL", CALPath + "Reference Microphone 74048 S.docx")
'Check that the ENV sensor is acually writing
If Format(FileDateTime(ENVPath + "TempValue.txt"), "yy-mm-dd") = Format(Date, "yy-mm-dd") Then
Call SelFind("TempValue", ReadFile(ENVPath + "TempValue.txt"))
Call SelFind("HumValue", ReadFile(ENVPath + "HumValue.txt"))
Call SelFind("BPValue", Format(CDbl(ReadFile(ENVPath + "bpValue.txt")) / 10, "#.0"))
Else
MsgBox ("Environmental sensor data is old. Read the current values and manually enter")
End If
'Selection.InsertFile (CALPath + "FX100 11375.docx")
If JustDoIt <> "DoIt" Then
myDoc.SaveAs2 (tempCertNo & "-" & myDoc.Name)
End If
End If
'Set myFlag to FALSE, avoid change next time opened
With HdrRange.Find
.ClearFormatting
.Text = "FLAGTRUE"
.Replacement.ClearFormatting
.Replacement.Text = "FLAGFALSE"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
If DontSave = False Then myDoc.Save 'save the damn thing
End Sub
Private Sub SelFind(SearchText As String, ReplaceText As String)
' 08 Apr 2017
Dim Rng As Range
Dim Fnd As Boolean
'Selection.WholeStory
Selection.HomeKey Unit:=wdStory
Set Rng = Selection.Range
With Rng.Find
.ClearFormatting
.Execute FindText:=SearchText, Forward:=True, _
Format:=False, Wrap:=wdFindStop
Fnd = .Found
End With
If Fnd = True Then
With Rng
'.MoveStart wdWord, -2
.Select
End With
If InStr(1, ReplaceText, "\") Then
Selection.InsertFile (ReplaceText)
Else
'Rng.Text = ReplaceText
With Rng.Find
'.ClearFormatting
.Execute FindText:=SearchText, Forward:=True, _
Format:=False, Wrap:=wdFindStop
.Replacement.ClearFormatting
.Replacement.Text = ReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
End If
End If
End Sub
Function ReadFile(myFile As String) As String
Open myFile For Input As #1
Line Input #1, textline
ReadFile = textline
Close #1
End Function
Function NextCertNo(myFile As String) As Double
Dim CurrNo As String
Open myFile For Input As #1
Line Input #1, CurrNo
Close #1
NextCertNo = CDbl(CurrNo) + 1
Open myFile For Output As #1
Write #1, NextCertNo
Close #1
End Function
Sub junk()
'With Selection.Find.Text("FX100CAL")
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:="Line 2"
End With
Selection.Text = ""
Set Rng = myDoc.Sections.Item(1).Range
Rng.Collapse wdCollapseEnd
'With Selection.Find
'.ClearFormatting
'.Text = "FX100CAL"
'.Replacement.ClearFormatting
'.Replacement.Text = ""
'.Execute Replace:=wdReplaceAll, Forward:=True, _
'Wrap:=wdFindContinue
' End With
End Sub
Sub Replace(mySelection As Selection, SearchText As String, ReplaceText As String)
With mySelection.Find
.ClearFormatting
.Text = SearchText
.Replacement.ClearFormatting
'.Replacement.Text = Format(Date, "dd-mm-yyyy")
.Replacement.Text = ReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
End Sub