Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Ajuda com Projeto d...
 
Notifications
Clear all

Ajuda com Projeto de Cadastro (FileCopy)

 
2024 - VBA & Macros
9 Posts
2 Usuários
0 Reactions
1,962 Visualizações
RSS
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Olá queridos amigos do fórum, gostaria de pedir a ajudar dos amigos mais uma vez.

No planilha em anexo existe um formulário para cadastro de dados e etc.
Nele há uma parte onde o usuário pode inserir anexos .pdf (digitalizações de contratos), sendo num total máximo de 12 anexos. Esses anexos geram um hiperlink na planilha e também são copiados para o local onde se encontra a planilha.
Se o usuário anexar os 12, o código funciona normalmente, ma se o usuário anexar menos de 12, (apenas 1, por exemplo) da erro de depuração.

Eu preciso de ajuda para permitir o usuário mesmo tendo a opção de anexar 12, poder anexar menos de 12. Mantendo essa estrutura de criar o hiperlink e copiar o arquivo.

Pra mim está complicado isso, mas sei que os feras aqui do fórum tiram isso de letra! Agradeço toda e qualquer ajuda!

base_daniele.rar
 
Postado : 15/10/2013 9:51 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

daniele, aqui no serviço não tenho como ver arq excel acima do 1003, mas se entendi você deve ter uma rotina limitando o numero de anexos a 12, e provavelmente nela deve ter um For x = 1 to 12, ou seja vai seguir até 12 e dependendo do tipo da variável que esta associada pode gerar erro uma vez que a mesma deve ter carregado a 12ª variável com valor NULO, então devemos colocar um ponto de interrupção na mesma onde comparamos os valores carregados e finalizamos a rotina antes de gerar o erro.

Se não aparecer nenhuma ajuda até eu sair do serviço, mais tarde, la em casa dou uma olhada no seu arquivo.
Ou coloque a rotina que está utilizando, quem sabe da para resolver analisando a mesma.

[]s

 
Postado : 15/10/2013 10:43 am
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Obrigado pela atenção Mauro Coutinho, eu entendi a lógica do que você disse, mas não sei por na prática. Estou a 2 dias olhando o código e não consigo concatenar idéias *-*
Não sou expert em vba, por isso meu código também é enorme e meio embaralhado. Mas estou postando o código, print e tbm uma versão em office 2003, pra você ou quem puder, pelo menos abrir.

Novamente agradeço a ajuda. Esse fórum tem me ajudado bastante nos meu projetos.

'========================================================================================================
 'BOTÕES CARREGAR ARQUIVO...
'========================================================================================================
Private Sub btnCarregarArquivo1_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao1 = ""
Else
txtCaminhoDigitalizacao1 = Endereco
txtCaminhoDigitalizacao1.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo2_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao2 = ""
Else
txtCaminhoDigitalizacao2 = Endereco
txtCaminhoDigitalizacao2.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo3_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao3 = ""
Else
txtCaminhoDigitalizacao3 = Endereco
txtCaminhoDigitalizacao3.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo4_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao4 = ""
Else
txtCaminhoDigitalizacao4 = Endereco
txtCaminhoDigitalizacao4.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo5_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao5 = ""
Else
txtCaminhoDigitalizacao5 = Endereco
txtCaminhoDigitalizacao5.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo6_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao6 = ""
Else
txtCaminhoDigitalizacao6 = Endereco
txtCaminhoDigitalizacao6.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo7_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao7 = ""
Else
txtCaminhoDigitalizacao7 = Endereco
txtCaminhoDigitalizacao7.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo8_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao8 = ""
Else
txtCaminhoDigitalizacao8 = Endereco
txtCaminhoDigitalizacao8.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo9_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao9 = ""
Else
txtCaminhoDigitalizacao9 = Endereco
txtCaminhoDigitalizacao9.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo10_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao10 = ""
Else
txtCaminhoDigitalizacao10 = Endereco
txtCaminhoDigitalizacao10.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo11_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao11 = ""
Else
txtCaminhoDigitalizacao11 = Endereco
txtCaminhoDigitalizacao11.Value = Endereco
End If
End Sub

Private Sub btnCarregarArquivo12_Click()
On Error Resume Next

Dim MyPath As String
Dim Endereco As String

MyPath = ActiveWorkbook.Path
Endereco = Application.GetOpenFilename("Arquivos pdf (*.pdf*),*.pdf*", , "Selecione o Arquivo")
If Endereco = "" Then
txtCaminhoDigitalizacao12 = ""
Else
txtCaminhoDigitalizacao12 = Endereco
txtCaminhoDigitalizacao12.Value = Endereco
End If
End Sub
'========================================================================================================
 'FIM BOTÕES CARREGAR ARQUIVO...
'========================================================================================================


Private Sub btn_Sair_Click()
Unload Me
End Sub


'========================================================================================================
 'PREENCHE COMBOBOX E OCULTA CAMPOS
'========================================================================================================
Private Sub cboTipoContrato_Change()
If Me.cboTipoContrato.Value = "TERMO ADITIVO" Then

Me.lbReferenteContrato.Left = 216
Me.lbReferenteContratoNumero.Left = 216
Me.lbReferenteContratoAno.Left = 252
Me.txtReferenteContratoNumero.Left = 216
Me.txtReferenteContratoAno.Left = 252

Me.lbReferenteContrato.Visible = True
Me.lbReferenteContratoNumero.Visible = True
Me.lbReferenteContratoAno.Visible = True
Me.txtReferenteContratoNumero.Visible = True
Me.txtReferenteContratoAno.Visible = True
Me.lbTermoAditivo.Visible = True
Me.lbNumeroTermoAditivo.Visible = True
Me.lbAnoTermoAditivo.Visible = True
Me.txtNumeroTermoAditivo.Visible = True
Me.txtAnoTermoAditivo.Visible = True
Else
Me.lbReferenteContrato.Visible = False
Me.lbReferenteContratoNumero.Visible = False
Me.lbReferenteContratoAno.Visible = False
Me.txtReferenteContratoNumero.Visible = False
Me.txtReferenteContratoAno.Visible = False
Me.lbTermoAditivo.Visible = False
Me.lbNumeroTermoAditivo.Visible = False
Me.lbAnoTermoAditivo.Visible = False
Me.txtNumeroTermoAditivo.Visible = False
Me.txtAnoTermoAditivo.Visible = False
End If
End Sub

Private Sub lbAnexarMaisArquivos1_Click()
Me.txtCaminhoDigitalizacao2.Visible = True
Me.btnCarregarArquivo2.Visible = True
Me.txtCaminhoDigitalizacao3.Visible = True
Me.btnCarregarArquivo3.Visible = True
Me.lbAnexarMaisArquivos1.Visible = False
Me.lbAnexarMaisArquivos2.Visible = True
Me.lbRemoverAnexos1.Visible = True
End Sub

Private Sub lbAnexarMaisArquivos2_Click()
Me.txtCaminhoDigitalizacao4.Visible = True
Me.btnCarregarArquivo4.Visible = True
Me.txtCaminhoDigitalizacao5.Visible = True
Me.btnCarregarArquivo5.Visible = True
Me.txtCaminhoDigitalizacao6.Visible = True
Me.btnCarregarArquivo6.Visible = True
Me.lbAnexarMaisArquivos2.Visible = False
Me.lbRemoverAnexos1.Visible = False
Me.lbAnexarMaisArquivos3.Visible = True
Me.lbRemoverAnexos2.Visible = True
End Sub

Private Sub lbAnexarMaisArquivos3_Click()
Me.txtCaminhoDigitalizacao7.Visible = True
Me.btnCarregarArquivo7.Visible = True
Me.txtCaminhoDigitalizacao8.Visible = True
Me.btnCarregarArquivo8.Visible = True
Me.txtCaminhoDigitalizacao9.Visible = True
Me.btnCarregarArquivo9.Visible = True
Me.lbAnexarMaisArquivos3.Visible = False
Me.lbRemoverAnexos2.Visible = False
Me.lbAnexarMaisArquivos4.Visible = True
Me.lbRemoverAnexos3.Visible = True
End Sub

Private Sub lbAnexarMaisArquivos4_Click()
Me.txtCaminhoDigitalizacao10.Visible = True
Me.btnCarregarArquivo10.Visible = True
Me.txtCaminhoDigitalizacao11.Visible = True
Me.btnCarregarArquivo11.Visible = True
Me.txtCaminhoDigitalizacao12.Visible = True
Me.btnCarregarArquivo12.Visible = True
Me.lbAnexarMaisArquivos1.Visible = False
Me.lbAnexarMaisArquivos2.Visible = False
Me.lbAnexarMaisArquivos3.Visible = False
Me.lbAnexarMaisArquivos4.Visible = False
End Sub

Private Sub lbRemoverAnexos1_Click()
Me.txtCaminhoDigitalizacao2.Visible = False
Me.btnCarregarArquivo2.Visible = False
Me.txtCaminhoDigitalizacao3.Visible = False
Me.btnCarregarArquivo3.Visible = False
Me.lbAnexarMaisArquivos2.Visible = False
Me.lbRemoverAnexos1.Visible = False
Me.lbAnexarMaisArquivos1.Visible = True
End Sub

Private Sub lbRemoverAnexos2_Click()
Me.txtCaminhoDigitalizacao2.Visible = False
Me.btnCarregarArquivo2.Visible = False
Me.txtCaminhoDigitalizacao3.Visible = False
Me.btnCarregarArquivo3.Visible = False
Me.txtCaminhoDigitalizacao4.Visible = False
Me.btnCarregarArquivo4.Visible = False
Me.txtCaminhoDigitalizacao5.Visible = False
Me.btnCarregarArquivo5.Visible = False
Me.txtCaminhoDigitalizacao6.Visible = False
Me.btnCarregarArquivo6.Visible = False
Me.lbAnexarMaisArquivos2.Visible = False
Me.lbRemoverAnexos1.Visible = False
Me.lbRemoverAnexos2.Visible = False
Me.lbAnexarMaisArquivos1.Visible = True
Me.lbAnexarMaisArquivos2.Visible = False
Me.lbAnexarMaisArquivos3.Visible = False
End Sub

Private Sub lbRemoverAnexos3_Click()
Me.lbAnexarMaisArquivos1.Visible = True
Me.lbRemoverAnexos1.Visible = False
Me.lbRemoverAnexos2.Visible = False
Me.lbRemoverAnexos3.Visible = False
Me.lbAnexarMaisArquivos4.Visible = False
Me.txtCaminhoDigitalizacao2.Visible = False
Me.btnCarregarArquivo2.Visible = False
Me.txtCaminhoDigitalizacao3.Visible = False
Me.btnCarregarArquivo3.Visible = False
Me.txtCaminhoDigitalizacao4.Visible = False
Me.btnCarregarArquivo4.Visible = False
Me.txtCaminhoDigitalizacao5.Visible = False
Me.btnCarregarArquivo5.Visible = False
Me.txtCaminhoDigitalizacao6.Visible = False
Me.btnCarregarArquivo6.Visible = False
Me.txtCaminhoDigitalizacao7.Visible = False
Me.btnCarregarArquivo7.Visible = False
Me.txtCaminhoDigitalizacao8.Visible = False
Me.btnCarregarArquivo8.Visible = False
Me.txtCaminhoDigitalizacao9.Visible = False
Me.btnCarregarArquivo9.Visible = False
Me.txtCaminhoDigitalizacao10.Visible = False
Me.btnCarregarArquivo10.Visible = False
Me.txtCaminhoDigitalizacao11.Visible = False
Me.btnCarregarArquivo11.Visible = False
Me.txtCaminhoDigitalizacao12.Visible = False
Me.btnCarregarArquivo12.Visible = False
End Sub


'========================================================================================================
 'FIM PREENCHE COMBOBOX E OCULTA CAMPOS
'========================================================================================================


Private Sub txtNumeroContrato_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Len(txtNumeroContrato) = 3 Then
txtAnoContrato.SetFocus
End If
End Sub

Private Sub txtAnoContrato_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Len(txtAnoContrato) = 4 Then
txtProcesso.SetFocus
End If
End Sub

Private Sub txtProcesso_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Me.txtProcesso.MaxLength = 25
End Sub


'========================================================================================================
 'QUEBRA DE LINHA NOS TEXTBOX
'========================================================================================================
Private Sub txtObjeto_Change()
ScrollBars = 2 - Vertical
multline = True
Locked = True
End Sub

Private Sub txtObservacao_Change()
ScrollBars = 2 - Vertical
multline = True
Locked = True
End Sub
'========================================================================================================
 'FIM QUEBRA DE LINHA NOS TEXTBOX
'========================================================================================================


'========================================================================================================
 'MÁSCARA PARA FORMATO MOEDA (R$ 0.000,00) E SOMENTE NUMEROS
'========================================================================================================
Private Sub txtValorMensal_AfterUpdate()
If IsNumeric(Me.txtValorMensal) = True Then
Me.txtValorMensal = Replace(Me.txtValorMensal, ",", "")
Me.txtValorMensal = Format(Me.txtValorMensal / 100, "R$ #,##0.00")
End If
 
If KeyAscii = vbKeyReturn Or KeyAscii = vbKeyBack Then Exit Sub
If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
KeyAscii = 0
ElseIf KeyAscii <> vbKeyDecimal Then
End If
End Sub

Private Sub txtValorGlobal_AfterUpdate()
If IsNumeric(Me.txtValorGlobal) = True Then
Me.txtValorGlobal = Replace(Me.txtValorGlobal, ",", "")
Me.txtValorGlobal = Format(Me.txtValorGlobal / 100, "R$ #,##0.00")
End If
 
If KeyAscii = vbKeyReturn Or KeyAscii = vbKeyBack Then Exit Sub
If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
KeyAscii = 0
ElseIf KeyAscii <> vbKeyDecimal Then
End If
End Sub
'========================================================================================================
 'MÁSCARA PARA FORMATO MOEDA (R$ 0.000,00) E SOMENTE NUMEROS
'========================================================================================================


'========================================================================================================
 'OCULTA LABEL E TEXTBOX. POPULA COMBOBOX NA INICIALIZAÇÃO DO FORM
'========================================================================================================
Private Sub UserForm_Initialize()
With Application
        .WindowState = xlMaximized
    End With
    
    With Me
        .Top = Application.Top
        .Left = Application.Left
        .Height = Application.Height
        .Width = Application.Width
    End With

'Oculta campos referente contrato
Me.lbReferenteContrato.Visible = False
Me.lbReferenteContratoNumero.Visible = False
Me.lbReferenteContratoAno.Visible = False
Me.txtReferenteContratoNumero.Visible = False
Me.txtReferenteContratoAno.Visible = False

'Oculta campos termo aditivo
Me.lbTermoAditivo.Visible = False
Me.lbNumeroTermoAditivo.Visible = False
Me.lbAnoTermoAditivo.Visible = False
Me.txtNumeroTermoAditivo.Visible = False
Me.txtAnoTermoAditivo.Visible = False

'Oculta campos anexar arquivos
Me.lbAnexarMaisArquivos2.Visible = False
Me.lbAnexarMaisArquivos3.Visible = False
Me.lbAnexarMaisArquivos4.Visible = False
Me.lbRemoverAnexos1.Visible = False
Me.lbRemoverAnexos2.Visible = False
Me.lbRemoverAnexos3.Visible = False
Me.txtCaminhoDigitalizacao2.Visible = False
Me.btnCarregarArquivo2.Visible = False
Me.txtCaminhoDigitalizacao3.Visible = False
Me.btnCarregarArquivo3.Visible = False
Me.txtCaminhoDigitalizacao4.Visible = False
Me.btnCarregarArquivo4.Visible = False
Me.txtCaminhoDigitalizacao5.Visible = False
Me.btnCarregarArquivo5.Visible = False
Me.txtCaminhoDigitalizacao6.Visible = False
Me.btnCarregarArquivo6.Visible = False
Me.txtCaminhoDigitalizacao7.Visible = False
Me.btnCarregarArquivo7.Visible = False
Me.txtCaminhoDigitalizacao8.Visible = False
Me.btnCarregarArquivo8.Visible = False
Me.txtCaminhoDigitalizacao9.Visible = False
Me.btnCarregarArquivo9.Visible = False
Me.txtCaminhoDigitalizacao10.Visible = False
Me.btnCarregarArquivo10.Visible = False
Me.txtCaminhoDigitalizacao11.Visible = False
Me.btnCarregarArquivo11.Visible = False
Me.txtCaminhoDigitalizacao12.Visible = False
Me.btnCarregarArquivo12.Visible = False

Me.cboModalidade.RowSource = "parametros!A1:A6"
Me.cboInicioDia.RowSource = "parametros!B1:B32"
Me.cboInicioMes.RowSource = "parametros!C1:C13"
Me.cboInicioAno.RowSource = "parametros!D1:D111"

Me.cboTerminoDia.RowSource = "parametros!B1:B32"
Me.cboTerminoMes.RowSource = "parametros!C1:C13"
Me.cboTerminoAno.RowSource = "parametros!D1:D111"
Me.cboTipoContrato.RowSource = "parametros!E1:E2"
End Sub
'========================================================================================================
 'FIM OCULTA LABEL E TEXTBOX. POPULA COMBOBOX NA INICIALIZAÇÃO DO FORM
'========================================================================================================


'========================================================================================================
 'SELECIONA PLANILHA E PROURA LINHA PARA GRAVAR DADOS
'========================================================================================================
Private Sub btn_Cadastrar_Click()
Sheets("contratos").Select
If Range("A3") = "" Then
lin = 3
    Else
    Range("A1").Select
    Selection.End(xlDown).Select
    lin = ActiveCell.Row + 1
End If
'========================================================================================================
 'FIM SELECIONA PLANILHA E PROURA LINHA PARA GRAVAR DADOS
'========================================================================================================


'========================================================================================================
 'INSERE DADOS NA PLANILHA
'========================================================================================================
Sheets("contratos").Cells(lin, 1).Value = Me.txtNumeroContrato.Value
Sheets("contratos").Cells(lin, 2).Value = Me.txtAnoContrato.Value
Sheets("contratos").Cells(lin, 3).Value = Me.txtProcesso.Value
Sheets("contratos").Cells(lin, 4).Value = Me.cboModalidade.Value
Sheets("contratos").Cells(lin, 5).Value = Me.txtBeneficiario.Value
Sheets("contratos").Cells(lin, 6).Value = Me.txtObjeto.Value
Sheets("contratos").Cells(lin, 7).Value = Me.cboInicioDia.Value
Sheets("contratos").Cells(lin, 8).Value = Me.cboInicioMes.Value
Sheets("contratos").Cells(lin, 9).Value = Me.cboInicioAno.Value
Sheets("contratos").Cells(lin, 10).Value = Me.cboTerminoDia.Value
Sheets("contratos").Cells(lin, 11).Value = Me.cboTerminoMes.Value
Sheets("contratos").Cells(lin, 12).Value = Me.cboTerminoAno.Value
Sheets("contratos").Cells(lin, 13).Value = Me.txtValorMensal.Value
Sheets("contratos").Cells(lin, 14).Value = Me.txtValorGlobal.Value
Sheets("contratos").Cells(lin, 15).Value = Me.txtSituacao.Value
Sheets("contratos").Cells(lin, 16).Value = Me.txtObservacao.Value
Sheets("contratos").Cells(lin, 17).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 18).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 19).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 20).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 21).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 22).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 23).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 24).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 25).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 26).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 27).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 28).Value = ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
'========================================================================================================
 'FIM INSERE DADOS NA PLANILHA
'========================================================================================================


'========================================================================================================
 'CRIAR HYPERLINK E FAZ CÓPIA DE DIGITALIZAÇÃO
'========================================================================================================
FileCopy txtCaminhoDigitalizacao1.Text, Sheets("contratos").Cells(lin, 17).Value
FileCopy txtCaminhoDigitalizacao2.Text, Sheets("contratos").Cells(lin, 18).Value
FileCopy txtCaminhoDigitalizacao3.Text, Sheets("contratos").Cells(lin, 19).Value
FileCopy txtCaminhoDigitalizacao4.Text, Sheets("contratos").Cells(lin, 20).Value
FileCopy txtCaminhoDigitalizacao5.Text, Sheets("contratos").Cells(lin, 21).Value
FileCopy txtCaminhoDigitalizacao6.Text, Sheets("contratos").Cells(lin, 22).Value
FileCopy txtCaminhoDigitalizacao7.Text, Sheets("contratos").Cells(lin, 23).Value
FileCopy txtCaminhoDigitalizacao8.Text, Sheets("contratos").Cells(lin, 24).Value
FileCopy txtCaminhoDigitalizacao9.Text, Sheets("contratos").Cells(lin, 25).Value
FileCopy txtCaminhoDigitalizacao10.Text, Sheets("contratos").Cells(lin, 26).Value
FileCopy txtCaminhoDigitalizacao11.Text, Sheets("contratos").Cells(lin, 27).Value
FileCopy txtCaminhoDigitalizacao12.Text, Sheets("contratos").Cells(lin, 28).Value

'Selecionando o local onde será "fixado" o Hiperlink
Sheets("contratos").Cells(lin, 17).Select
Sheets("contratos").Cells(lin, 18).Select
Sheets("contratos").Cells(lin, 19).Select
Sheets("contratos").Cells(lin, 20).Select
Sheets("contratos").Cells(lin, 21).Select
Sheets("contratos").Cells(lin, 22).Select
Sheets("contratos").Cells(lin, 23).Select
Sheets("contratos").Cells(lin, 24).Select
Sheets("contratos").Cells(lin, 25).Select
Sheets("contratos").Cells(lin, 26).Select
Sheets("contratos").Cells(lin, 27).Select
Sheets("contratos").Cells(lin, 28).Select

'Incluindo o hiperlink
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
'========================================================================================================
 'FIM CRIAR HYPERLINK E FAZ CÓPIA DE DIGITALIZAÇÃO
'========================================================================================================

MsgBox "Cadastro realizado com sucesso!", vbInformation, "SUCESSO"
Unload Me
frmCadastro.Show
End Sub


'========================================================================================================
 'MÁSCARA PARA INSERIR "."
'========================================================================================================
'Private Sub txtInscricao_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'   Select Case KeyAscii
'       Case 8, 48 To 57
'               Me.txtInscricao.MaxLength = 10  'Quantidade máxima de caracteres no txtInscricao
'               If Len(txtInscricao) = 2 Then txtInscricao = txtInscricao + "."
'               If Len(txtInscricao) = 6 Then txtInscricao = txtInscricao + "."
'       Case Else
'           KeyAscii = 0 'Limita o txtInscricao a receber apenas números
'   End Select
'End Sub


'========================================================================================================
 'OBRIGA QUE O TEXTO SEJA MAIÚSCULO, INDEPENDENTE DE CAPASLOCK ATIVADO
'========================================================================================================
'Private Sub txtRazaoSocial_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'KeyAscii = Asc(UCase(Chr(KeyAscii)))
'End Sub

'Private Sub txtNomeDocumento_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'KeyAscii = Asc(UCase(Chr(KeyAscii)))
'End Sub


'========================================================================================================
 'DETERMINA CAMPOS OBRIGATÓRIOS
'========================================================================================================
'Private Sub txtInscricao_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'If txtInscricao.Value = "" Then
'   MsgBox ("Atenção, o preenchimento do campo 'Inscrição Estadual' é obrigatório."), vbCritical, "AATENÇÃO"
'   Cancel = True
'End If
'End Sub

'Private Sub txtRazaoSocial_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'If txtRazaoSocial.Value = "" Then
'   MsgBox ("Atenção, o preenchimento do campo 'Razao Social' é obrigatório."), vbCritical, "ATENÇÃO"
'   Cancel = True
'End If
'End Sub

'Private Sub txtNomeDocumento_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'If txtNomeDocumento.Value = "" Then
'   MsgBox ("Atenção, o preenchimento do campo 'Nome do Documento' é obrigatório."), vbCritical, "ATENÇÃO"
'   Cancel = True
'End If
'End Sub

base_daniele_v2003.rar
 
Postado : 15/10/2013 11:11 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

biloka, de fato as rotinas estão bem embaralhadas, e pelo que entendi o erro não está na quantidade dos lançamentos serem menores que 12 e sim por ter alem dos Controles Invisiveis tambem estão Vazios, e na hora do lançamento Instrução FileCopy da erro, e como o tempo é curto para ajustar o projeto inteiro, vou postar uma sugestão para a questão destes TextBox(s) "txtCaminhoDigitalizacao", veja se consegue assimilar a idéia e fazer os demais ajustes.

Vamos lá, na Rotina do Botão : Private Sub btn_Cadastrar_Click() faça as seguintes alterações:
Private Sub btn_Cadastrar_Click()
'Acrescente esta linhas no Inicio
Dim cControl As Control 'Refere-se aos Controles
Dim sCol As Long 'Coluna para lançamento dos dados

sCol = 17 'Coluna Inicial para os lançamentos

Depois na parte onde tem :
'========================================================================================================
'CRIAR HYPERLINK E FAZ CÓPIA DE DIGITALIZAÇÃO
'========================================================================================================
FileCopy txtCaminhoDigitalizacao1.Text, Sheets("contratos").Cells(lin, 17).Value
FileCopy txtCaminhoDigitalizacao2.Text, Sheets("contratos").Cells(lin, 18).Value
FileCopy txtCaminhoDigitalizacao3.Text, Sheets("contratos").Cells(lin, 19).Value
FileCopy txtCaminhoDigitalizacao4.Text, Sheets("contratos").Cells(lin, 20).Value
FileCopy txtCaminhoDigitalizacao5.Text, Sheets("contratos").Cells(lin, 21).Value
FileCopy txtCaminhoDigitalizacao6.Text, Sheets("contratos").Cells(lin, 22).Value
FileCopy txtCaminhoDigitalizacao7.Text, Sheets("contratos").Cells(lin, 23).Value
FileCopy txtCaminhoDigitalizacao8.Text, Sheets("contratos").Cells(lin, 24).Value
FileCopy txtCaminhoDigitalizacao9.Text, Sheets("contratos").Cells(lin, 25).Value
FileCopy txtCaminhoDigitalizacao10.Text, Sheets("contratos").Cells(lin, 26).Value
FileCopy txtCaminhoDigitalizacao11.Text, Sheets("contratos").Cells(lin, 27).Value
FileCopy txtCaminhoDigitalizacao12.Text, Sheets("contratos").Cells(lin, 28).Value

Substitua todas estas linhas acima pelas abaixo'

For Each cControl In Me.Controls 'Para cada Controle no Formulário
    
        If TypeName(cControl) = "TextBox" Then 'Se for do Tipo Controle TEXTBOX
                   
            If cControl.Visible = False Then 'Se o Controle estiver Invisivel
                    
            Else
                'Se o Nome do Controle for Igual a "txtCaminhoDigitalizacao" e diferente de vazio
                If Mid(cControl.Name, 1, 23) = "txtCaminhoDigitalizacao" And cControl.Value <> "" Then
                
                'Adiciona o Caminho referente ao Controle "cControl" na Linha e Coluna armazenada nas Variáveis lin e sCol
                FileCopy cControl.Text, Sheets("contratos").Cells(lin, sCol).Value
                                   
                'Incrementa + 1 a Coluna para o proximo lançamento
                sCol = sCol + 1
                    
                End If
            End If
            
        End If
        
    Next cControl

Nas instruções acima estamos verificando se o Tipo de Controle é um TextBox, se o mesmo está Visivel, se estiver Visivel, verificamos se o nome começa por "txtCaminhoDigitalizacao" e se o mesmo não está vazio, apesar que esta segunda condição poderia ser descartada uma vez que só são preenchido se estiverem Visiveis, então se as condições forem positivas faz os lançamentos.

Ajuste sua rotina e faça os testes e qq duvida retorne.

[]s

 
Postado : 15/10/2013 6:33 pm
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Mauro, obrigado pela ajuda. Inclui a solução proposta e resolveu o problema no FileCopy. Mas acabei encontrando outros 2 problemas no meu projeto que não tem mais haver com o FileCopy.

O primeiro problema é que está salvando o caminho do arquivo nas 12 colunas de anexo, sendo que repetido, ou seja, se o usuário inserir apenas 1 anexo, ele salva o caminho nas 12 colunas e não apenas na sua correspondente (a primeira das 12, no caso).

O segundo é que está gerando o hiperlink apenas na 12ª coluna (na ultima), e o correto seria gerar o hiperlink na coluna que tiver o caminho do arquivo.
Não sei bem, tanto que não sei consertar, mas acho que o problema está aqui:

'Selecionando o local onde será "fixado" o Hiperlink
Sheets("contratos").Cells(lin, 17).Select
Sheets("contratos").Cells(lin, 18).Select
Sheets("contratos").Cells(lin, 19).Select
Sheets("contratos").Cells(lin, 20).Select
Sheets("contratos").Cells(lin, 21).Select
Sheets("contratos").Cells(lin, 22).Select
Sheets("contratos").Cells(lin, 23).Select
Sheets("contratos").Cells(lin, 24).Select
Sheets("contratos").Cells(lin, 25).Select
Sheets("contratos").Cells(lin, 26).Select
Sheets("contratos").Cells(lin, 27).Select
Sheets("contratos").Cells(lin, 28).Select

E aqui também:

randomico = 0
randomico = 1 + Int(Rnd * 9999)

'Insere dados na planilha
Sheets("contratos").Cells(lin, 1).Value = Me.txtNumeroContrato.Value
Sheets("contratos").Cells(lin, 2).Value = Me.txtAnoContrato.Value
Sheets("contratos").Cells(lin, 3).Value = Me.txtProcesso.Value
Sheets("contratos").Cells(lin, 4).Value = Me.cboModalidade.Value
Sheets("contratos").Cells(lin, 5).Value = Me.txtBeneficiario.Value
Sheets("contratos").Cells(lin, 6).Value = Me.txtObjeto.Value
Sheets("contratos").Cells(lin, 7).Value = Me.cboInicioDia.Value
Sheets("contratos").Cells(lin, 8).Value = Me.cboInicioMes.Value
Sheets("contratos").Cells(lin, 9).Value = Me.cboInicioAno.Value
Sheets("contratos").Cells(lin, 10).Value = Me.cboTerminoDia.Value
Sheets("contratos").Cells(lin, 11).Value = Me.cboTerminoMes.Value
Sheets("contratos").Cells(lin, 12).Value = Me.cboTerminoAno.Value
Sheets("contratos").Cells(lin, 13).Value = Me.txtValorMensal.Value
Sheets("contratos").Cells(lin, 14).Value = Me.txtValorGlobal.Value
Sheets("contratos").Cells(lin, 15).Value = Me.txtSituacao.Value
Sheets("contratos").Cells(lin, 16).Value = Me.txtObservacao.Value
Sheets("contratos").Cells(lin, 17).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 18).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 19).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 20).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 21).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 22).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 23).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 24).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 25).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 26).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 27).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"
Sheets("contratos").Cells(lin, 28).Value = ThisWorkbook.Path & "" & randomico & " - " & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf" 'ThisWorkbook.Path & "" & txtNumeroContrato.Text & "-" & txtAnoContrato & " - " & txtProcesso & " - " & txtBeneficiario.Text & ".pdf"

Mas segue a planilha em anexo (versão 2003 e 2010)

projeto daniele.rar
 
Postado : 16/10/2013 8:43 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

bilokas, como eu disse, as rotinas em seu projeto são um pouco extensas e dependem de um tempo a mais disponivel para analisar cada situação referente ao Private Sub btn_Cadastrar_Click(), o que fiz foi uma otimização somente da parte que comentou sobre o erro, e disse que terá de ir ajustando as demais linhas, por exemplo :

Eu não entendi porque tem nesta rotina as instruções para Selecionar os range (um de cada vez, sequancialmente) na parte Selecionando o local onde será "fixado" o Hiperlink se não está executando nenhuma ação apos selecionar, outra coisa, nas instruções que ajustei, criei a Variavel para a Coluna (sCol) e você ja tem a da linha Lin, ou seja, terá de ver quais valores estão sendo carregados nestas variáveis.

[]s

 
Postado : 16/10/2013 11:25 am
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Sim Mauro, entendi. Estou postando para ver se mais alguém do Fórum pode ajudar.

 
Postado : 16/10/2013 11:43 am
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Mudando para resolvido por conta de ninguém responder :/

 
Postado : 18/10/2013 5:47 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Mudando para resolvido por conta de ninguém responder :/

bilokas, já que não tem mais necessidade de ajuda neste Tópico e o mesmo na minha opinião não está Resolvido, vou volta-lo a condição de não Resolvido, e pela forma que colocou, entendo que não tem mais interesse no mesmo, e portanto vou tranca-lo.

QUanto a sua posição e citação devo lembra-lo que estamos em um Forum onde toda a ajuda é VOLUNTÁRIA, nenhum dos que destinam alguns minutos de seu tempo para ajudar é remunerado para tal e nem por isso deixam de ajudar.
Então, diante disto temos de ter um pouco mais de paciência, acho injusto colocar uma resposta da forma que postou uma vez que desde o seu cadastro no Forum em 19/09/13 você teve mais da metade das 24 mensgagens que colocou resolvida.

Finalizando, devo alerta-lo que tal atitude é passivel de aplicação de advertência podendo futuramente até ser Banido do Forum, mas como nossa intensão é sempre procurarmos manter o Forum o mais amigável possivel, peço a gentileza de evitar tais atitudes futuramente.

Mauro Coutinho
Moderador

 
Postado : 18/10/2013 11:12 am
Forum Jump:
  Tópico Anterior
Próximo Tópico