Ir para o conteúdo
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

j_r_m_c

criar pequeno programa

Mensagens Recomendadas

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

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros 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

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros 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

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.