Advertisement
Guest User

Untitled

a guest
Jun 4th, 2014
261
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Imports Microsoft.Vbe.Interop
  2.  
  3. Public Class MacroInsert
  4.     Private strFilenameToConvert As String
  5.     Private procLine As Long
  6.     Private oDoc As New Microsoft.Office.Interop.Word.Document
  7.     Private vbProj As Microsoft.Vbe.Interop.VBProject
  8.     Private vbc As Microsoft.Vbe.Interop.VBComponent
  9.     Private vbcode As Microsoft.Vbe.Interop.CodeModule
  10.     Private wordApp = New Microsoft.Office.Interop.Word.Application
  11.     Private oModule As VBComponent
  12.     Dim obj As Object
  13.     Public exMacro As Boolean
  14.     Dim newMacro As Boolean
  15.     Public exMacroOld As Boolean
  16.     Dim VBALineCount As Long
  17.  
  18.     Public Function AbrirWord(ByVal Local As String, ByVal Show As Boolean, ByVal displayAlert As Boolean, ByVal EnableMacro As Boolean)
  19.         wordApp.Application.DisplayAlerts = displayAlert
  20.         wordApp.Visible = Show
  21.  
  22.         If EnableMacro = False Then
  23.             wordApp.AutomationSecurity = Microsoft.Office.Core.MsoAutomationSecurity.msoAutomationSecurityForceDisable
  24.         End If
  25.  
  26.         oDoc = wordApp.Documents.Open(Local)
  27.  
  28.         vbProj = oDoc.VBProject
  29.  
  30.         If (oDoc.VBProject.VBComponents.Count() < 1) Then
  31.             oDoc.VBProject.VBComponents.Add(vbext_ComponentType.vbext_ct_StdModule)
  32.             newMacro = True
  33.         End If
  34.  
  35.         vbc = oDoc.VBProject.VBComponents(vbext_ComponentType.vbext_ct_StdModule)
  36.         vbcode = vbc.CodeModule
  37.  
  38.         ReadMacros()
  39.        
  40.             Return 0
  41.     End Function
  42.  
  43.     Private Function ReadMacros()
  44.         On Error GoTo NoOldMacro
  45.         If vbcode.ProcCountLines("ReturnUserName", vbext_ProcKind.vbext_pk_Proc) > 0 Then
  46.             exMacroOld = True
  47.         End If
  48.  
  49.         On Error GoTo NoMacro
  50.         If vbcode.ProcCountLines("AutoOpen", vbext_ProcKind.vbext_pk_Proc) > 0 Then
  51.             exMacro = True
  52.         End If
  53.  
  54. NoMacro:
  55.         exMacro = False
  56.  
  57. NoOldMacro:
  58.         exMacroOld = False
  59.  
  60.         Return 0
  61.     End Function
  62.  
  63.     Public Function GravarInit(ByVal Local As String, ByVal Macro As String)
  64.         wordApp.Application.DisplayAlerts = False
  65.         wordApp.Visible = False
  66.  
  67.         wordApp.AutomationSecurity = Microsoft.Office.Core.MsoAutomationSecurity.msoAutomationSecurityForceDisable
  68.  
  69.  
  70.         oDoc = wordApp.Documents.Open(Local)
  71.  
  72.         vbProj = oDoc.VBProject
  73.  
  74.         If (oDoc.VBProject.VBComponents.Count() < 1) Then
  75.             oDoc.VBProject.VBComponents.Add(vbext_ComponentType.vbext_ct_StdModule)
  76.         End If
  77.  
  78.         vbc = oDoc.VBProject.VBComponents(vbext_ComponentType.vbext_ct_StdModule)
  79.         vbcode = vbc.CodeModule
  80.  
  81.         GravarMacro(Macro)
  82.  
  83.         Return 0
  84.  
  85.     End Function
  86.  
  87.     Public Function PreencherCampo(ByVal Valor As String, ByVal index As Integer)
  88.         oDoc.FormFields(index).Result = Valor
  89.         Return 0
  90.     End Function
  91.  
  92.     Public Function SaveAs(ByVal local As String)
  93.         wordApp.ActiveDocument.SaveAs(local)
  94.         Return (0)
  95.     End Function
  96.  
  97.     Public Function LockDocument()
  98.         oDoc.Protect(Microsoft.Office.Interop.Word.WdProtectionType.wdAllowOnlyFormFields)
  99.         Return 0
  100.     End Function
  101.  
  102.     Public Function GetDocumentState() As Integer
  103.  
  104.         If oDoc.ProtectionType = Microsoft.Office.Interop.Word.WdProtectionType.wdNoProtection Then
  105.             Return 1
  106.         Else
  107.             Return 2
  108.         End If
  109.  
  110.         Return 0
  111.     End Function
  112.  
  113.     Public Function ListAllFields()
  114.  
  115.         For i As Integer = 1 To oDoc.FormFields.Count()
  116.             oDoc.FormFields(i).OwnHelp = True
  117.             oDoc.FormFields(i).HelpText = i
  118.         Next
  119.  
  120.         Return 0
  121.     End Function
  122.  
  123.     Public Function protectDoc(ByVal pass As String)
  124.         oDoc.Protect(Microsoft.Office.Interop.Word.WdProtectionType.wdAllowOnlyFormFields, True, pass)
  125.         Return 0
  126.     End Function
  127.  
  128.     Public Function UnprotectDoc(ByVal pass As String) As Boolean
  129.         Dim password As Object
  130.         password = pass
  131.  
  132.         oDoc.Save()
  133.  
  134.         On Error GoTo ErrnoProtec
  135.         oDoc.Password = 0
  136.         oDoc.Save()
  137.         oDoc.Unprotect(password)
  138.         oDoc.Save()
  139.         Return True
  140.  
  141. ErrnoProtec:
  142.         Return False
  143.     End Function
  144.  
  145.     Public Function ClearAllFields()
  146.  
  147.         For i As Integer = 1 To oDoc.FormFields.Count()
  148.             oDoc.FormFields(i).TextInput.Clear()
  149.         Next
  150.  
  151.         Return 0
  152.     End Function
  153.  
  154.     Public Function GravarMacro(ByVal filePat As String)
  155.  
  156.         If exMacro Then
  157.             vbcode.InsertLines(vbcode.ProcStartLine("AutoOpen", vbext_ProcKind.vbext_pk_Proc), "ProtDoc()")
  158.         End If
  159.  
  160.         vbcode.AddFromFile(filePat)
  161.  
  162.         oDoc.RunAutoMacro(Microsoft.Office.Interop.Word.WdAutoMacros.wdAutoOpen)
  163.         Return 0
  164.     End Function
  165.  
  166.     Private Function countCodeLines()
  167.         Dim obj As Object
  168.         Dim VBALineCount As Long
  169.         For Each obj In oDoc.VBProject.VBComponents
  170.             VBALineCount = VBALineCount + obj.CodeModule.CountOfLines
  171.         Next obj
  172.         Return VBALineCount
  173.     End Function
  174.  
  175.     Public Function Close()
  176.         oDoc.Close()
  177.         Return (0)
  178.     End Function
  179. End Class
Advertisement
RAW Paste Data Copied
Advertisement