I want to determine if something has changed in a catpart that would drive a change in a body, but the change hasnt been done because update is set to manual.
I have tried:
if part.product.update = true then
'do something
else
'do something else
endif
However this just forces an update and doesnt tell me if one was required.
I worked out a solution (see below)
'#####################
Function func_CheckNoModsSinceLastSaved() As Boolean
func_CheckNoModsSinceLastSaved = False
Dim flg_NoModsSinceLastSaved As Boolean
flg_NoModsSinceLastSaved = False
If Right(CATIA.ActiveDocument.FullName, 11) = ".CATProduct" Then
Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = productDocument1.Product
flg_NoModsSinceLastSaved = productDocument1.Saved
If flg_NoModsSinceLastSaved Then
func_CheckNoModsSinceLastSaved = True
Else
func_CheckNoModsSinceLastSaved = False
MsgBox "Modified Since Last Saved"
End If
product1.Update
flg_NoModsSinceLastSaved = productDocument1.Saved
If flg_NoModsSinceLastSaved Then
func_CheckNoModsSinceLastSaved = True
Else
func_CheckNoModsSinceLastSaved = False
MsgBox "Modified Since Last Saved"
End If
Set productDocument1 = Nothing
ElseIf Right(CATIA.ActiveDocument.FullName, 8) = ".CATPart" Then
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
flg_NoModsSinceLastSaved = partDocument1.Saved
If flg_NoModsSinceLastSaved Then
func_CheckNoModsSinceLastSaved = True
Else
func_CheckNoModsSinceLastSaved = False
MsgBox "Modified Since Last Saved"
End If
partDocument1.Part.Update
flg_NoModsSinceLastSaved = partDocument1.Saved
If flg_NoModsSinceLastSaved Then
func_CheckNoModsSinceLastSaved = True
Else
func_CheckNoModsSinceLastSaved = False
MsgBox "Modified Since Last Saved"
End If
Set partDocument1 = Nothing
ElseIf Right(CATIA.ActiveDocument.FullName, 11) = ".CATDrawing" Then
Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument
flg_NoModsSinceLastSaved = drawingDocument1.Saved
If flg_NoModsSinceLastSaved Then
func_CheckNoModsSinceLastSaved = True
Else
func_CheckNoModsSinceLastSaved = False
MsgBox "Modified Since Last Saved"
End If
drawingDocument1.Update
flg_NoModsSinceLastSaved = drawingDocument1.Saved
If flg_NoModsSinceLastSaved Then
func_CheckNoModsSinceLastSaved = True
Else
func_CheckNoModsSinceLastSaved = False
MsgBox "Modified Since Last Saved"
End If
Set drawingDocument1 = Nothing
Else
MsgBox "ERROR: Unidentified File Type!", vbCritical + vbOKOnly, ""
End If
End Function
'#####################
Check CATIA Settings
Set mySettControlers = CATIA.SettingControllers
Set myPartInfraSetting = mySettControlers.Item("CATMmuPartInfrastructureSettingCtrl")
Check how is set myPartInfraSetting.UpdateMode and see if is catManualUpdate or catAutomaticUpdate
Related
I am trying to run a if statement to send an email if the sub has run and is successful.
The current code I am trying is
Private Sub SendButton_Click()
Call Populate
If Populate = True Then
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "New ePRF Available"
.Body = "I have completed a new e-PRF"
.To = ""
.Importance = olImportanceNormal
.attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Else
Call Populate
End If
End Sub
This is something I have never really done before so am very confused! Any help would be grateful!
Thanks
Make Populate a function and have it return a boolean value, then check that value in SendButton_Click
I made a nonsense populate to show the general idea.
Option Explicit
Private Sub SendButton_Click()
If populate() Then 'Test the return
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "New ePRF Available"
.Body = "I have completed a new e-PRF"
.To = ""
.Importance = olImportanceNormal
.attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Else
Call populate 'This is probably not what you actually want, but hard to tell without seeing populate
End If
End Sub
Function populate() As Boolean 'specify the return type
Dim returnval As Boolean
Dim x As Boolean
Dim y As Boolean
returnval = True 'Start with true, if anything is false below flip the value
x = True
y = False
'just showing the flow, you would be checking your userform values here
If Not x Then
returnval = False
ElseIf Not y Then
returnval = False
End If
populate = returnval 'return the value
End Function
Scenario
I have a word document where I have a table as shown in Image 1. The checkboxes are used to show the next contents. For example, I have in first step yes and no, when yes is checked the next content is shown. And in next step, I have thre Checkboxes with case 1,2 and 3 respectively.
When the case 1 is checked I have next a text that is filled via vba as F1Feld1...till F4Feld1.
Problem
First problem is, I am unable to create a function where only yes and no can be checked as well as either of the case can be checked. Second, problem is that the vba for case checkboxes run perfectly when I have them created separate but when combined together only case 1 vba runs.
Following is my code:
Option Explicit
Dim tabelle As Table, zelle As Cell
Private Sub Document_ContentControlOnEnter(ByVal CC As ContentControl)
Dim r As Range
Set tabelle = ActiveDocument.Bookmarks("local").Range.Tables(1)
If ActiveDocument.SelectContentControlsByTag("Yes").Item(1).Checked = True Then
ActiveDocument.SelectContentControlsByTag("No").Item(1).Checked = False
Call local_blockiert
Else: Call local_offen
End If
If ActiveDocument.SelectContentControlsByTag("Case1").Item(1).Checked = True Then
On Error Resume Next
With ActiveDocument
.Bookmarks("TB1").Range.Text = "F1Feld1": .Bookmarks("TB1").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB2").Range.Text = "F1Fed2": .Bookmarks("TB2").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB3").Range.Text = "F1Feld3": .Bookmarks("TB3").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB4").Range.Text = "F1Feld4": .Bookmarks("TB4").Range.Font.ColorIndex = wdBlack
End With
ElseIf ActiveDocument.SelectContentControlsByTag("Case1").Item(1).Checked = False Then
With ActiveDocument
.Bookmarks("TB1").Range.Text = ""
.Bookmarks("TB2").Range.Text = ""
.Bookmarks("TB3").Range.Text = ""
.Bookmarks("TB4").Range.Text = ""
End With
ElseIf ActiveDocument.SelectContentControlsByTag("Case2").Item(1).Checked = True Then
With ActiveDocument
.Bookmarks("TB1").Range.Text = "F2Feld1": .Bookmarks("TB1").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB2").Range.Text = "F2Fed2": .Bookmarks("TB2").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB3").Range.Text = "F2Feld3": .Bookmarks("TB3").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB4").Range.Text = "F2Feld4": .Bookmarks("TB4").Range.Font.ColorIndex = wdBlack
End With
ElseIf ActiveDocument.SelectContentControlsByTag("Case2").Item(1).Checked = False Then
With ActiveDocument
.Bookmarks("TB1").Range.Text = ""
.Bookmarks("TB2").Range.Text = ""
.Bookmarks("TB3").Range.Text = ""
.Bookmarks("TB4").Range.Text = ""
End With
ElseIf ActiveDocument.SelectContentControlsByTag("Case3").Item(1).Checked = True Then
With ActiveDocument
.Bookmarks("TB1").Range.Text = "F3Feld1": .Bookmarks("TB1").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB2").Range.Text = "F3Fed2": .Bookmarks("TB2").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB3").Range.Text = "F3Feld3": .Bookmarks("TB3").Range.Font.ColorIndex = wdBlack
.Bookmarks("TB4").Range.Text = "F3Feld4": .Bookmarks("TB4").Range.Font.ColorIndex = wdBlack
End With
ElseIf ActiveDocument.SelectContentControlsByTag("Case3").Item(1).Checked = False Then
With ActiveDocument
.Bookmarks("TB1").Range.Text = ""
.Bookmarks("TB2").Range.Text = ""
.Bookmarks("TB3").Range.Text = ""
.Bookmarks("TB4").Range.Text = ""
End With
End If
End Sub
Private Sub local_blockiert()
Dim i As Long, j As Long
On Error GoTo fehler
With ActiveDocument.Bookmarks("local").Range
.Font.ColorIndex = wdWhite
End With
fehler:
Call AllesAuf
End Sub
Private Sub local_offen()
Dim i As Long, j As Long
On Error GoTo fehler
With ActiveDocument.Bookmarks("YesorNo").Range
.Font.ColorIndex = wdBlack
End With
fehler:
Call AllesAuf
End Sub
Private Sub yes_blockiert()
Dim j As Long
On Error GoTo fehler
With tabelle.Cell(2, 2)
.Shading.ForegroundPatternColorIndex = wdGray25
.Range.Font.ColorIndex = wdGray25
For j = 1 To .Range.ContentControls.Count
.Range.ContentControls(j).LockContents = True
Next j
End With
Exit Sub
fehler:
Call AllesAuf
End Sub
Private Sub yes_offen()
Dim j As Long
On Error GoTo fehler
With tabelle.Cell(2, 2)
For j = 1 To .Range.ContentControls.Count
.Range.ContentControls(j).LockContents = False
Next j
.Shading.ForegroundPatternColor = RGB(255, 242, 204)
.Range.Font.ColorIndex = wdAuto
End With
Exit Sub
fehler:
Call AllesAuf
End Sub
Private Sub AllesAuf()
Dim i As Long
With ActiveDocument
For i = 1 To .ContentControls.Count
.ContentControls(i).LockContents = False
Next i
End With
End Sub
I am quite new to vba and I need to write a script that has as input a document with some revisions. For each paragraph i would like to have in a table the original text (no revisions) and the final text (as if all revisions have been accepted). If this is to difficult I would like to at least have a table that contains the new text, the number of the paragraph in the original document and the number of the paragraph in the final version
Here an example of how could look like the input of the script
Here what i would like to have as output
Here what I have been able to do. I am not able to get the original text and in case of multiple phrases insertion the script is able to recognize only the first one as new line.
The script go through all the paragraph, if the paragraph contains no revision just the text is added in the table. If the text contains at list one revision all except the last revision are accepted and if the last the revision is an insert then if the paragraph text before and after all revisions have been accepted is the same the next paragraph is considered as new line. If the last revision is a delete then if the paragraph text before all revisions have been accepted is equal to the text of reviosion the text paragraph is considered as interely deleted.
Sub TrackchangesTable()
Dim oDoc As Document
Dim oNewDoc As Document
Dim oTable As Table
Dim oRow As Row
Dim oCol As Column
Dim oRange As Range
Dim oRevision As Revision
Dim strText As String
Dim Title As String
Dim Para As Paragraph
Dim NewLine As Boolean
Dim DraftText As String
Dim NewId As Long
Dim OldId As Long
Dim OldText As String
Dim Stile As String
Dim OriginalDoc As Document
Set oDoc = ActiveDocument
If oDoc.Revisions.Count = 0 Then
MsgBox "The active document contains no tracked changes.", vbOKOnly, Title
GoTo ExitHere
Else
If MsgBox("Do you want to extract tracked changes to a new document?" & vbCr & vbCr & , _
vbYesNo + vbQuestion) <> vbYes Then
GoTo ExitHere
End If
End If
Application.ScreenUpdating = False
Set oNewDoc = Documents.Add
oNewDoc.PageSetup.Orientation = wdOrientLandscape
With oNewDoc
.Content = ""
With .PageSetup
.LeftMargin = CentimetersToPoints(2)
.RightMargin = CentimetersToPoints(2)
.TopMargin = CentimetersToPoints(2.5)
End With
Set oTable = .Tables.Add _
(Range:=Selection.Range, _
numrows:=1, _
NumColumns:=7)
End With
With oNewDoc.Styles(wdStyleNormal)
With .Font
.Name = "Arial"
.Size = 9
.Bold = False
End With
With .ParagraphFormat
.LeftIndent = 0
End With
End With
With oTable
.Range.Style = wdStyleNormal
.AllowAutoFit = False
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
For Each oCol In .Columns
oCol.PreferredWidthType = wdPreferredWidthPercent
Next oCol
.Columns(1).PreferredWidth = 5 'Page
.Columns(2).PreferredWidth = 5 'Note
.Columns(3).PreferredWidth = 10 'Final Text
.Columns(4).PreferredWidth = 15 'Inserted/deleted text
.Columns(5).PreferredWidth = 15 'Old Id
.Columns(6).PreferredWidth = 10 'New ID
.Columns(7).PreferredWidth = 10 'Stile
End With
With oTable.Rows(1)
.Cells(1).Range.Text = "Page"
.Cells(2).Range.Text = "Note"
.Cells(3).Range.Text = "Final Text"
.Cells(4).Range.Text = "Deleted Text"
.Cells(5).Range.Text = "Old Id"
.Cells(6).Range.Text = "New Id"
.Cells(7).Range.Text = "stile"
End With
NewLine = False
OldId = 1
NewId = 1
For Each Para In ThisDocument.Paragraphs
Stile = Para.Range.Style
If Para.Range.Revisions.Count = 0 And NewLine = False Then
StrTextFinale = Para.Range.Text
ElseIf Para.Range.Revisions.Count = 0 And NewLine = True Then
StrTextFinale = Para.Range.Text
Note = "New Line"
NewLine = False
OldId = OldId - 1
ElseIf Para.Range.Revisions.Count > 0 Then
For i = 1 To Para.Range.Revisions.Count
If i < Para.Range.Revisions.Count Then
Para.Range.Revisions(i).Accept
Else
If Para.Range.Revisions(i).Type = wdRevisionInsert Then
DraftText = Para.Range.Text
Para.Range.Revisions(i).Accept
StrTextFinale = Para.Range.Text
If DraftText = StrTextFinale Then
NewLine = True
End If
ElseIf Para.Range.Revisions(i).Type = wdRevisionDelete Then
DraftText = Para.Range.Revisions(i).Range.Text
StrTextFinale = Para.Range.Text
If DraftText = StrTextFinale Then
Note = "Testo eliminato"
StrTextFinale = "volutamente cancellato"
OldText = Para.Range.Text
NewId = NewId - 1
Else
Para.Range.Revisions(i).Accept
StrTextFinale = Para.Range.Text
End If
End If
End If
Next
End If
Set oRow = oTable.Rows.Add
With oRow
.Cells(1).Range.Text = Para.Range.Information(wdActiveEndAdjustedPageNumber)
.Cells(2).Range.Text = Note
.Cells(3).Range.Text = StrTextFinale
.Cells(4).Range.Text = OldText
.Cells(5).Range.Text = OldId
.Cells(6).Range.Text = NewId
.Cells(7).Range.Text = Stile
Note = ""
End With
OldId = OldId + 1
NewId = NewId + 1
OldText = ""
Next
With oTable.Rows(1)
.Range.Font.Bold = True
.HeadingFormat = True
End With
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox ("Over")
ExitHere:
Set oDoc = Nothing
Set oNewDoc = Nothing
Set oTable = Nothing
Set oRow = Nothing
Set oRange = Nothing
End Sub
Can somebody help me to improve this script?
Set SapGuiAuto = GetObject("SAPGUI")
Set SapApp = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = SapApp.Children(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject SapApp, "on"
End If
Dim SO_ref As String
Dim PO_order As String
Dim ship_cond As String
Dim antal As Integer
Dim i As Integer
antal = Range("F8").Value
Range("E11:E40").Clear
If OPT_Cust1.Value = True Then
SO_ref = Range("F2").Value
PO_order = Range("G2").Value
ship_cond = Range("H2").Value
Else
End If
If OPT_Cust2.Value = True Then
SO_ref = Range("F3").Value
PO_order = Range("G3").Value
ship_cond = Range("H3").Value
End If
If Cust3.Value = True Then
SO_ref = Range("F4").Value
PO_order = Range("G4").Value
ship_cond = Range("H4").Value
End If
If Cust4.Value = True Then
SO_ref = Range("F5").Value
PO_order = Range("G5").Value
ship_cond = Range("H5").Value
End If
i = 1
Do While i < antal + 1
session.findById("wnd[0]").resizeWorkingPane 160, 38, False
'session.createSession
session.findById("wnd[0]/tbar[0]/okcd").Text = "va01"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtVBAK-AUART").Text = "ABC1" ' Order Type
session.findById("wnd[0]/usr/ctxtVBAK-VKORG").Text = "xxxx"
session.findById("wnd[0]/usr/ctxtVBAK-VTWEG").Text = "xx"
session.findById("wnd[0]/usr/ctxtVBAK-SPART").Text = "xx"
session.findById("wnd[0]/usr/ctxtVBAK-VKBUR").Text = "xxxx"
session.findById("wnd[0]/usr/ctxtVBAK-VKGRP").Text = "xxx"
I got this script for creation of SO "headers". Currently it working fine but I need to add one more customer for which Order type will be different.
Say if the Cust4 is selected then the Order Type should be ABC2 otherwise it should always choose ABC1.
How can this function be added to the script?
Try the next approach, please:
Dim boolType2 as Boolean
'...your existing code
If Cust4.Value = True Then
boolType2 = True
SO_ref = Range("F5").Value
PO_order = Range("G5").Value
ship_cond = Range("H5").Value
End If
'...your existing code
session.findById("wnd[0]/usr/ctxtVBAK-AUART").Text = _
IIf(boolType2 = True, "ABC2", "ABC1")
'...your existing code
You can create such boolean variables for many other types, if necessary... IIf supports imbricate functions.
Edited:
If your above used controls are check boxes, your code must check if only one of them would be checked. Otherwise, the code will take the values from the last (ticked) one...
If the check boxes are ActiveX type, you can use each of them Change event, in order to un-tick the others. If not, try adapting your code in the next way, which will do the same thing, but less elegant (on my taste)...
If OPT_Cust1.Value = True Then
If OPT_Cust2.Value = True Or _
Cust3.Value = True Or _
Cust4.Value = True Then _
MsgBox "Another check box is also ticked!": Exit Sub
SO_ref = Range("F2").Value
PO_order = Range("G2").Value
ship_cond = Range("H2").Value
ElseIf OPT_Cust2.Value = True Then
If Cust3.Value = True Or Cust4.Value = True Then _
MsgBox "Another check box is also ticked!": Exit Sub
SO_ref = Range("F3").Value
PO_order = Range("G3").Value
ship_cond = Range("H3").Value
ElseIf Cust3.Value = True Then
If Cust4.Value = True Then _
MsgBox "Cust4 check box is also ticked!": Exit Sub
SO_ref = Range("F4").Value
PO_order = Range("G4").Value
ship_cond = Range("H4").Value
ElseIf Cust4.Value = True Then
boolType2 = True
SO_ref = Range("F5").Value
PO_order = Range("G5").Value
ship_cond = Range("H5").Value
End If
Just add variable of "Order Type" and set it for every Cust to your SAP scipt.
If Cust4.Value = True Then
SO_ref = Range("F5").Value
PO_order = Range("G5").Value
ship_cond = Range("H5").Value
Type = "ABCD2"
End If
session.findById("wnd[0]/usr/ctxtVBAK-AUART").Text = Type ' Order Type
Hope I've helped.
Have a great day :).
I'm pretty new at VBA. I have a form with a text box and a check box. If I open the form and click the check box without populating the text box, I get a message box to enter comments.
However, in the same session, if I unchecked the box and recheck it, I do not get the message box to enter comments even tho the text box is blank.
How can I get the code to "refire" in the same session to give me the message box to enter comments?
Below is my code:
Private Sub Check29_Click()
If IsNull(Me.Text16) Then
MsgBox "Comments are Required.", vbCritical
Me.Check29 = Null
Exit Sub
Else
If Me.Check29 = -1 Then
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("Exclusions", dbOpenDynaset)
RS.AddNew
RS("HW535ID") = Me![HWID]
RS("Excluded") = "Yes"
RS("BOA Assignee") = Me![AssignedBA]
RS("Comments") = Me![Text16]
RS("CheckBox") = Me![Check29]
RS("Date of Exclusion") = Me![Text115]
RS("ReviewID") = Me![Text33]
RS.Update
RS.Close
Set RS = Nothing
Exit Sub
Else
DoCmd.SetWarnings False
DoCmd.OpenQuery ("RemoveExclusion")
Me.Text16 = Null
Exit Sub
End If
End If
End Sub
I can see a logic problem in the code. Please be aware that this line:
Me.Check29 = Null
will re-trigger the _click event and produce unexpected results. And it is also incorrect (should be Me.Check29.Value=False). Please try the revised version below:
Declare a module level variable
Option Explicit
Private bCancel as Boolean
The event code (I also made more corrections):
Private Sub Check29_Click()
if bCancel Then Exit Sub
bCancel = False
If Trim(Me.Text16.Text) = vbnullstring Then
MsgBox "Comments are Required.", vbCritical
bCancel = True
Me.Check29.Value = False
bCancel = False
Exit Sub
Else
If Me.Check29.Value = True Then
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("Exclusions", dbOpenDynaset)
RS.AddNew
RS("HW535ID") = Me![HWID]
RS("Excluded") = "Yes"
RS("BOA Assignee") = Me![AssignedBA]
RS("Comments") = Me![Text16]
RS("CheckBox") = Me![Check29]
RS("Date of Exclusion") = Me![Text115]
RS("ReviewID") = Me![Text33]
RS.Update
RS.Close
Set RS = Nothing
Exit Sub
Else
DoCmd.SetWarnings False
DoCmd.OpenQuery ("RemoveExclusion")
Me.Text16.Text = vbnullstring
Exit Sub
End If
End If
End Sub
Private Sub Check29_Click()
If bCancel Then Exit Sub
bCancel = False
Me.Text16.SetFocus
If Trim(Me.Text16.Text) = vbNullString And Me.Check29.Value = True Then
MsgBox "Comments are Required.", vbCritical
bCancel = True
Me.Check29.Value = False
bCancel = False
Exit Sub
Else
If Me.Check29.Value = True Then
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("Exclusions", dbOpenDynaset)
RS.AddNew
RS("HW535ID") = Me![HWID]
RS("Excluded") = "Yes"
RS("BOA Assignee") = Me![AssignedBA]
RS("Comments") = Me![Text16]
RS("CheckBox") = Me![Check29]
RS("Date of Exclusion") = Me![Text115]
RS("ReviewID") = Me![Text33]
RS.Update
RS.Close
Set RS = Nothing
Exit Sub
Else
If Me.Check29.Value = False Then
DoCmd.SetWarnings False
DoCmd.OpenQuery ("RemoveExclusion")
Me.Text16 = ""
Exit Sub
End If
End If
End If
End Sub