Jump to content
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

Sign in to follow this  
j_r_m_c

criar pequeno programa

Recommended Posts

j_r_m_c

olá

preciso criar uma macro que qd abrir.

- crie um numero sequencial (vai ver qual o ultimo e acrescenta +1)

- após preencher alguns campos de texto, passe esta informação  para um doc com os campos de numero gerado e o texto (será o título) preenchido anteriormente

- esta informação deverá tb ir para um ficheiro em excel que servirá tb de controlo à numeração sequencial

não sei se me fiz entender

Share this post


Link to post
Share on other sites
j_r_m_c

ok

só me falta resolver a ultima questão

actualmente descarrega tudo para a celula A1  e separa por ; os campos

eu pretendo que escreve nas várias células ao longo da linha 1

Share this post


Link to post
Share on other sites
j_r_m_c

vou tentar

mas neste momento estou em casa e não consigo executar a macro

aparece

512 - valor fora do intervalo admissível

no trabalho um dos PC tb aparece este erro nos restantes trabalham bem

por isso não é da macro mas sim de alguma definição do PC. alguma ideia?

aproveito para por a macro

Public Sub MAIN()

On Error GoTo ver_erro

ReDim cod_servico_(0), servico_(0), cod_rel_(0), data_ano(0), n_rel(0), n_unid(0), n_assunto(0), n_data(0), n_equip(0)

'Dim a_lista(0, 0, 0, 0, 0)

Dim ha, l_rel

Dim num, n

Dim D

Dim numrel$

Dim d_$

Dim em$

Dim E$

Dim encontra

Dim botao

Dim nl_

Dim x

Dim ml$

Dim ano$

Dim data_i As Date

        ijanela$ = UCase$(WordBasic.[windowname$](i))

        If UCase(Right(ijanela$, 6)) = "(COPY)" Then

            aaa = MsgBox("Aplicação a ser usada por outro utilizador", vbOKOnly, "RELATÓRIOS")

            Application.Quit

        End If

proc = 0

texto$ = ""

fich$ = ""

unidade$ = ""

qunid$ = ""

caminho = ActiveDocument.Path

ser = UCase$(ActiveDocument.Name)

proc = 0

texto$ = ""

fich$ = ""

unidade$ = ""

qunid$ = ""

caminho = ActiveDocument.Path

ser = UCase$(ActiveDocument.Name)

data_ano = Format(Date, "yy")

cod_rel = "EI"

inicio:

    fich$ = Dir(caminho + "\" + cod_rel + data_ano + ".lst")

    'If Mid(fich$, 2, 4) <> data_ano Then fich$ = ""

    If fich$ = "" Then

        numero = cod_rel + data_ano + "0000"

    Else

        Open caminho + "\" + fich$ For Input As #1

        Do While Not EOF(1)

            Input #1, numero, data, un, equip, Assunto, nota, ordem

        Loop

        Close #1

    End If

    numero = Mid(numero, 3, 6)

    qjanela$ = ser

    ha = WordBasic.Val(janela(qjanela$))

    If ha > WordBasic.CountWindows() Then GoTo Fim

    CommandBars("Standard").Visible = False

    CommandBars("Formatting").Visible = False

    CommandBars("Drawing").Visible = False

    'CommandBars("PDFMaker 4.0").Visible = False

    Selection.EndKey unit:=wdStory

    ActiveWindow.WindowState = wdWindowStateMaximize

    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit

    relpar = ""

    CI_D_2.n_rel = Trim(cod_rel) + Trim(Str(numero + 1))

    CI_D_2.data = Mid(Now(), 1, 10)

    CI_D_2.servico = servico$

    CI_D_2.Label18 = servico$

    CI_D_2.Show

    If Retorno = 12 Then GoTo abre_rel

    If Retorno = 2 Then GoTo ver_lista            'lista relatórios

    If Retorno = 1 Then GoTo novo_rel            'novo relatório

    If Retorno = 22 Then GoTo inicio

    If Retorno = 3 Then

        CommandBars("Standard").Visible = True

        CommandBars("Formatting").Visible = True

        WordBasic.fileexit

    End If

    Stop

   

''*********************************************************************

novo_rel:

    CI_D_2.Hide

    If Val(Mid(CI_D_2.n_rel, 3, 6)) < numero + 1 Then                          'abrir relatório existente

        fich$ = Dir(caminho + "\" + CI_D_2.n_rel + ".doc")

        CI_D_1.Hide

        CI_D_2.Hide

        Documents.Open FileName:=caminho + "\" + fich$

        qjanela$ = UCase(fich$)

        WordBasic.WindowList WordBasic.Val(janela(qjanela$))

        ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit

        ActiveWindow.WindowState = wdWindowStateMaximize

    Else

        If Val(Mid(CI_D_2.n_rel, 3, 6)) > numero + 1 Then numero = Val(Mid(CI_D_2.n_rel, 3, 6)) - 1

        If relpar <> "" Then CI_D_2.Assunto = "PARAGEM " & CI_D_2.Assunto

        botao = MsgBox("Vou gravar como " + CI_D_2.n_rel + ". Confirma?", vbOKCancel, "RELATÓRIOS INSPECÇÃO ESTÁTICA")

        If botao = 1 Then

            If relpar = "" Then Documents.Open FileName:=caminho + "\O_relatorio.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2001", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2001", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "D" Then Documents.Open FileName:=caminho + "\Acumuladores IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "AE" Then Documents.Open FileName:=caminho + "\Aero-arrefeced IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "C" Then Documents.Open FileName:=caminho + "\Colunas IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "H" Then Documents.Open FileName:=caminho + "\Fornalhas IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "E" Then Documents.Open FileName:=caminho + "\Permutadores IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "EDP" Then Documents.Open FileName:=caminho + "\Permutad DP IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "R" Then Documents.Open FileName:=caminho + "\Reactores IP.doc", ConfirmConversions:=False, _

                ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="2003", _

                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="2003", _

                WritePasswordTemplate:="", Format:=wdOpenFormatAuto

            If relpar = "" Then

                ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

                Selection.EndKey unit:=wdStory

                Selection.MoveUp unit:=wdLine, Count:=1

                Selection = servico

                ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

            End If

            Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1

            If relpar = "" Then

                Selection.MoveDown unit:=wdLine, Count:=1

            Else

                Selection.MoveDown unit:=wdLine, Count:=5

            End If

            Selection = UCase(CI_D_2.n_rel)

            Selection.MoveRight unit:=wdCell

            Selection = UCase(CI_D_2.equip)

            Selection.MoveRight unit:=wdCell

            Selection = CI_D_2.unidade

            Selection.MoveRight unit:=wdCell

            Selection = UCase(CI_D_2.origem)

            Selection.MoveRight unit:=wdCell

            Selection = CI_D_2.nota

            Selection.MoveDown unit:=wdLine, Count:=2

            Selection = CI_D_2.ordem

            Selection.MoveLeft unit:=wdCell

            Selection = UCase(CI_D_2.Assunto)

            ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

            Selection.MoveDown unit:=wdLine, Count:=1

            'Selection = data_i

            Selection.MoveRight unit:=wdCharacter, Count:=1

            'selection=inspector

            Selection.MoveRight unit:=wdCharacter, Count:=1

            Selection = Mid(Now(), 1, 10)

            ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

            Selection.HomeKey unit:=wdStory

            E$ = caminho + "\" + CI_D_2.n_rel + ".doc"

            'botao = MsgBox("Vou gravar como " + CI_D_2.n_rel + ". Confirma?", vbOKCancel, "RELATÓRIOS INSPECÇÃO ESTÁTICA")

            'If botao = 1 Then

            fich_l$ = caminho + "\" + cod_rel + data_ano + ".lst"

            Open fich_l$ For Append As #1

                n_ass = UCase$(CI_D_2.Assunto)

                If Right(n_ass, 1) = Chr(34) Then n_ass = Mid(n_ass, 1, Len(n_ass) - 1) + "POL"

                MyPos = InStr(1, n_ass, Chr(34))

                Do While MyPos > 0

                    If MyPos > 0 Then n_ass = Mid(n_ass, 1, MyPos - 1) + "POL " + Mid(n_ass, MyPos + 1, Len(n_ass))

                    MyPos = InStr(1, n_ass, Chr(34))

                Loop

               

                n_eq = UCase$(CI_D_2.equip)

                If Right(n_eq, 1) = Chr(34) Then n_eq = Mid(n_eq, 1, Len(n_eq) - 1) + "POL"

                MyPos = InStr(1, n_eq, Chr(34))

                Do While MyPos > 0

                    If MyPos > 0 Then n_eq = Mid(n_eq, 1, MyPos - 1) + "POL " + Mid(n_eq, MyPos + 1, Len(n_eq))

                    MyPos = InStr(1, n_eq, Chr(34))

                Loop

                Write #1, UCase(Trim(cod_rel)) + Trim(Str(numero + 1)), CI_D_2.data, CI_D_2.unidade, n_eq, n_ass, CI_D_2.nota, CI_D_2.ordem

            Close #1

            With ActiveDocument

                .ReadOnlyRecommended = False

                .EmbedTrueTypeFonts = False

                .SaveFormsData = False

                .SaveSubsetFonts = False

                .Password = ""

                .WritePassword = ""

            End With

            Application.DefaultSaveFormat = ""

            ActiveDocument.SaveAs FileName:=E$, FileFormat:= _

                wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles _

                :=True, WritePassword:="", ReadOnlyRecommended:=False, _

                EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _

                :=False, SaveAsAOCELetter:=False

            GoTo Fim

        Else

            'ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

            GoTo inicio

        End If

    End If

    GoTo Fim

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.