Sub Atualiza() ActiveDocument.Fields.Update ' Atualiza os campos do documento Selection.WholeStory Selection.Fields.ToggleShowCodes 'Mostra conteudo var doc Selection.HomeKey Unit:=wdStory 'Posiciona o cursor até o inicio do documento Application.WindowState = wdWindowStateMaximize 'Maximiza janela do word End Sub 'PARA NÃO UTILIZAR A MACRO DEVE SER CRIADA A FUNCAO COM O NOME DA MACRO VAZIA 'POIS O EXECMACRO NAO RETORNA SE EXISTE OU NAO Sub SEMMACRO() 'COLOCAR O NOME DA MACRO 'MACROS EXISTENTES 'TABFINAN = ABA FINANCEIRO NN7 'TABCADEN = ABA CADENCIA NNY 'TABCREDI = ABA CESSAO DE CREDITO NNG 'TABCORRE = ABA CORRETORAS NNF End Sub 'REALIZA A IMPRESSAO DA TABELA FINANCEIRA DO CONTRATO NN7 Sub TABFINAN() 'Variaveis de controle Dim nPos As Integer Dim cMemo As String Dim cText As String Dim nContador As Integer Dim lEof As Boolean Dim nLin As Integer Dim nCol As Integer Dim nReg As Integer
ActiveDocument.ActiveWindow.View.FieldShading = _ wdFieldShadingWhenSelected
'Conta a variavel cMemo que retorna da rotina OGRR342 nContador = ActiveDocument.Fields.Count If nContador >= 1 Then With ActiveDocument.Fields(1) .Update cMemo = Trim(.Result.Text) .Result.Text = "" End With With ActiveDocument.Fields(2) .Update nReg = Val(Trim(.Result.Text)) .Result.Text = "" End With End If
'Informa que será impresso na seção 2 [Count:=2] Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=2, Name:="" Selection.Find.ClearFormatting With Selection.Find .Text = "/" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With
'Criando a tabela Set myTable = _ ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=nReg, _ NumColumns:=8)
myTable.AutoFormat Format:=wdTableFormatProfessional, _ ApplyBorders:=True, ApplyShading:=True, ApplyFont:=False, ApplyColor:=True _ , ApplyHeadingRows:=False, ApplyLastRow:=False, ApplyFirstColumn:=False, _ ApplyLastColumn:=False, AutoFit:=True
'alinha o texto ao meio horizontal e vertical myTable.Select Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'a soma InchesToPoints não devem passar 6.6 - AJUSTA O TAMANHO DAS COLUNAS myTable.Columns(1).Width = InchesToPoints(0.5) myTable.Columns(2).Width = InchesToPoints(0.8) myTable.Columns(3).Width = InchesToPoints(1.1) myTable.Columns(4).Width = InchesToPoints(0.7) myTable.Columns(5).Width = InchesToPoints(0.8) myTable.Columns(6).Width = InchesToPoints(0.4) myTable.Columns(7).Width = InchesToPoints(1) myTable.Columns(8).Width = InchesToPoints(0.4)
'cabeçalho da tabela - DEVE SER IMPRESSO TODAS AS COLUNAS AQUI DESCRITAS myTable.Columns(1).Cells(1).Range.Text = "PARC" myTable.Columns(2).Cells(1).Range.Text = "VENCTO" myTable.Columns(3).Cells(1).Range.Text = "VALOR" myTable.Columns(4).Cells(1).Range.Text = "BANCO" myTable.Columns(5).Cells(1).Range.Text = "AGENCIA" myTable.Columns(6).Cells(1).Range.Text = "DG" myTable.Columns(7).Cells(1).Range.Text = "CONTA" myTable.Columns(8).Cells(1).Range.Text = "DG"
'Alinha o conteudo das linhas e colunas myTable.Columns(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(3).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight myTable.Columns(4).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(5).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(6).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(7).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(8).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Trata estilo da tabela '[primeira linha alinhado ao centro/negrito/cor] myTable.Rows(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter Selection.Font.Bold = wdToggle 'Altera_Fundo
'Passar informacoes de coluna e linha '[qual coluna e linha que deve comecar a preencher] lEof = True nCol = 1 nLin = 2
'Realiza a impressao do campo memo que a rotina OGRR342 transmite While (lEof) nPos = InStr(cMemo, "#*") cText = Mid(cMemo, 1, nPos - 1) cMemo = Mid(cMemo, nPos + 2)
'Imprime o texto na coluna e linha informada myTable.Cell(nLin, nCol).Range.Text = cText
'Soma a coluna ate chegar na coluna 8 [definido pela rotina OGRR342] 'Se for maior que 8 entra no IF para somar a linha nCol = nCol + 1 If nCol > 8 Then nCol = 1 nLin = nLin + 1 End If
'Se imprimiu tudo sai do while e termina a impressao If IsEmpty(cMemo) Or nLin > (nReg) Then lEof = False End If Wend End Sub 'REALIZA A IMPRESSAO DA TABELA CADENCIA DO CONTRATO NNY Sub TABCADEN() 'Variaveis de controle Dim nPos As Integer Dim cMemo As String Dim cText As String Dim nContador As Integer Dim lEof As Boolean Dim nLin As Integer Dim nCol As Integer Dim nReg As Integer
ActiveDocument.ActiveWindow.View.FieldShading = _ wdFieldShadingWhenSelected
'Conta a variavel cMemo que retorna da rotina OGRR342 nContador = ActiveDocument.Fields.Count If nContador >= 1 Then With ActiveDocument.Fields(1) .Update cMemo = Trim(.Result.Text) .Result.Text = "" End With With ActiveDocument.Fields(2) .Update nReg = Val(Trim(.Result.Text)) .Result.Text = "" End With End If
'Informa que será impresso na seção 3 [Count:=3] Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=3, Name:="" Selection.Find.ClearFormatting With Selection.Find .Text = "/" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With
'Criando a tabela Set myTable = _ ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=nReg, _ NumColumns:=5)
myTable.AutoFormat Format:=wdTableFormatProfessional, _ ApplyBorders:=True, ApplyShading:=True, ApplyFont:=False, ApplyColor:=True _ , ApplyHeadingRows:=False, ApplyLastRow:=False, ApplyFirstColumn:=False, _ ApplyLastColumn:=False, AutoFit:=True
'alinha o texto ao meio horizontal e vertical myTable.Select Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'a soma InchesToPoints não devem passar 6.6 - AJUSTA O TAMANHO DAS COLUNAS myTable.Columns(1).Width = InchesToPoints(0.8) myTable.Columns(2).Width = InchesToPoints(0.8) myTable.Columns(3).Width = InchesToPoints(1.1) myTable.Columns(4).Width = InchesToPoints(1.9) myTable.Columns(5).Width = InchesToPoints(1.9) 'cabeçalho da tabela - DEVE SER IMPRESSO TODAS AS COLUNAS AQUI DESCRITAS myTable.Columns(1).Cells(1).Range.Text = "DT INI" myTable.Columns(2).Cells(1).Range.Text = "DT FIN" myTable.Columns(3).Cells(1).Range.Text = "QUANTIDADE" myTable.Columns(4).Cells(1).Range.Text = "ENT ORIGEM" myTable.Columns(5).Cells(1).Range.Text = "ENT DESTINO"
'Alinha o conteudo das linhas e colunas myTable.Columns(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(3).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight myTable.Columns(4).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft myTable.Columns(5).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
myTable.Rows(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter Selection.Font.Bold = wdToggle
'Passar informacoes de coluna e linha '[qual coluna e linha que deve comecar a preencher] lEof = True nCol = 1 nLin = 2
'Realiza a impressao do campo memo que a rotina OGRR342 transmite While (lEof) nPos = InStr(cMemo, "#*") cText = Mid(cMemo, 1, nPos - 1) cMemo = Mid(cMemo, nPos + 2)
'Imprime o texto na coluna e linha informada myTable.Cell(nLin, nCol).Range.Text = cText
'Soma a coluna ate chegar na coluna 8 [definido pela rotina OGRR342] 'Se for maior que 8 entra no IF para somar a linha nCol = nCol + 1 If nCol > 5 Then nCol = 1 nLin = nLin + 1 End If
'Se imprimiu tudo sai do while e termina a impressao If IsEmpty(cMemo) Or nLin > (nReg) Then lEof = False End If Wend End Sub 'REALIZA A IMPRESSAO DA TABELA CORRETORAS DO CONTRATO NNF Sub TABCORRET() 'Variaveis de controle Dim nPos As Integer Dim cMemo As String Dim cText As String Dim nContador As Integer Dim lEof As Boolean Dim nLin As Integer Dim nCol As Integer Dim nReg As Integer
ActiveDocument.ActiveWindow.View.FieldShading = _ wdFieldShadingWhenSelected
'Conta a variavel cMemo que retorna da rotina OGRR342 nContador = ActiveDocument.Fields.Count If nContador >= 1 Then With ActiveDocument.Fields(1) .Update cMemo = Trim(.Result.Text) .Result.Text = "" End With With ActiveDocument.Fields(2) .Update nReg = Val(Trim(.Result.Text)) .Result.Text = "" End With End If
'Informa que será impresso na seção 4 [Count:=4] Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=4, Name:="" Selection.Find.ClearFormatting With Selection.Find .Text = "/" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With
'Criando a tabela Set myTable = _ ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=nReg, _ NumColumns:=4)
myTable.AutoFormat Format:=wdTableFormatProfessional, _ ApplyBorders:=True, ApplyShading:=True, ApplyFont:=False, ApplyColor:=True _ , ApplyHeadingRows:=False, ApplyLastRow:=False, ApplyFirstColumn:=False, _ ApplyLastColumn:=False, AutoFit:=True
'alinha o texto ao meio horizontal e vertical myTable.Select Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'a soma InchesToPoints não devem passar 6.6 - AJUSTA O TAMANHO DAS COLUNAS myTable.Columns(1).Width = InchesToPoints(2.2) myTable.Columns(2).Width = InchesToPoints(2.2) myTable.Columns(3).Width = InchesToPoints(1.2) myTable.Columns(4).Width = InchesToPoints(1) 'cabeçalho da tabela - DEVE SER IMPRESSO TODAS AS COLUNAS AQUI DESCRITAS myTable.Columns(1).Cells(1).Range.Text = "ENTIDADE" myTable.Columns(2).Cells(1).Range.Text = "CORRETORA" myTable.Columns(3).Cells(1).Range.Text = "VLR COMISSÃO" myTable.Columns(4).Cells(1).Range.Text = "% COMISSÃO"
'Alinha o conteudo das linhas e colunas myTable.Columns(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft myTable.Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft myTable.Columns(3).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight myTable.Columns(4).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
myTable.Rows(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter Selection.Font.Bold = wdToggle 'Altera_Fundo
'Passar informacoes de coluna e linha '[qual coluna e linha que deve comecar a preencher] lEof = True nCol = 1 nLin = 2
'Realiza a impressao do campo memo que a rotina OGRR342 transmite While (lEof) nPos = InStr(cMemo, "#*") cText = Mid(cMemo, 1, nPos - 1) cMemo = Mid(cMemo, nPos + 2)
'Imprime o texto na coluna e linha informada myTable.Cell(nLin, nCol).Range.Text = cText
'Soma a coluna ate chegar na coluna 8 [definido pela rotina OGRR342] 'Se for maior que 8 entra no IF para somar a linha nCol = nCol + 1 If nCol > 4 Then nCol = 1 nLin = nLin + 1 End If
'Se imprimiu tudo sai do while e termina a impressao If IsEmpty(cMemo) Or nLin > (nReg) Then lEof = False End If Wend End Sub 'REALIZA A IMPRESSAO DA TABELA CESSAO DE CREDITO NNG Sub TABCESSC() 'Variaveis de controle Dim nPos As Integer Dim cMemo As String Dim cText As String Dim nContador As Integer Dim lEof As Boolean Dim nLin As Integer Dim nCol As Integer Dim nReg As Integer
ActiveDocument.ActiveWindow.View.FieldShading = _ wdFieldShadingWhenSelected
'Conta a variavel cMemo que retorna da rotina OGRR342 nContador = ActiveDocument.Fields.Count If nContador >= 1 Then With ActiveDocument.Fields(1) .Update cMemo = Trim(.Result.Text) .Result.Text = "" End With With ActiveDocument.Fields(2) .Update nReg = Val(Trim(.Result.Text)) .Result.Text = "" End With End If
'Informa que será impresso na seção 5 [Count:=5] Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=5, Name:="" Selection.Find.ClearFormatting With Selection.Find .Text = "/" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With
'Criando a tabela Set myTable = _ ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=nReg, _ NumColumns:=8)
myTable.AutoFormat Format:=wdTableFormatProfessional, _ ApplyBorders:=True, ApplyShading:=True, ApplyFont:=False, ApplyColor:=True _ , ApplyHeadingRows:=False, ApplyLastRow:=False, ApplyFirstColumn:=False, _ ApplyLastColumn:=False, AutoFit:=True
'alinha o texto ao meio horizontal e vertical myTable.Select Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'a soma InchesToPoints não devem passar 6.6 - AJUSTA O TAMANHO DAS COLUNAS myTable.Columns(1).Width = InchesToPoints(1) myTable.Columns(2).Width = InchesToPoints(1) myTable.Columns(3).Width = InchesToPoints(1.1) myTable.Columns(4).Width = InchesToPoints(0.7) myTable.Columns(5).Width = InchesToPoints(0.8) myTable.Columns(6).Width = InchesToPoints(0.4) myTable.Columns(7).Width = InchesToPoints(1) myTable.Columns(8).Width = InchesToPoints(0.4)
'cabeçalho da tabela - DEVE SER IMPRESSO TODAS AS COLUNAS AQUI DESCRITAS myTable.Columns(1).Cells(1).Range.Text = "FAVORECIDO" myTable.Columns(2).Cells(1).Range.Text = "QTD CESSÃO" myTable.Columns(3).Cells(1).Range.Text = "VALOR PGTO" myTable.Columns(4).Cells(1).Range.Text = "BANCO" myTable.Columns(5).Cells(1).Range.Text = "AGENCIA" myTable.Columns(6).Cells(1).Range.Text = "DG" myTable.Columns(7).Cells(1).Range.Text = "CONTA" myTable.Columns(8).Cells(1).Range.Text = "DG"
'Alinha o conteudo das linhas e colunas myTable.Columns(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(3).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight myTable.Columns(4).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(5).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(6).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(7).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter myTable.Columns(8).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Trata estilo da tabela '[primeira linha alinhado ao centro/negrito/cor] myTable.Rows(1).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter Selection.Font.Bold = wdToggle Altera_Fundo
'Passar informacoes de coluna e linha '[qual coluna e linha que deve comecar a preencher] lEof = True nCol = 1 nLin = 2
'Realiza a impressao do campo memo que a rotina OGRR342 transmite While (lEof) nPos = InStr(cMemo, "#*") cText = Mid(cMemo, 1, nPos - 1) cMemo = Mid(cMemo, nPos + 2)
'Imprime o texto na coluna e linha informada myTable.Cell(nLin, nCol).Range.Text = cText
'Soma a coluna ate chegar na coluna 8 [definido pela rotina OGRR342] 'Se for maior que 8 entra no IF para somar a linha nCol = nCol + 1 If nCol > 8 Then nCol = 1 nLin = nLin + 1 End If
'Se imprimiu tudo sai do while e termina a impressao If IsEmpty(cMemo) Or nLin > (nReg) Then lEof = False End If Wend End Sub
|