@edsonbr vou tentar explicar o que eu preciso, porém não tenho permissão para anexar as planilhas, que contém dados confidenciais. Caso seja realmente necessário posso tentar falar com o responsável.
A planilha que usamos para dimensionamento de materiais busca dados em mais 3 pastas de trabalhos. Esses arquivos se encontram em uma pasta do diretório de um usuário da empresa, porém hoje precisamos migrar esses arquivos para uma pasta da rede, cujo caminho é totalmente diferente.
Seria simples alterar os vínculos se não fossem aproximadamente 1000 dessas planilhas de dimensionamento (mesma estrutura), com 5 abas protegidas por senha (a mesma para todas), sendo 4 dessas ocultas. Como você pode imaginar, os usuários dessas planilhas não podem ter conhecimento da senha, o que impossibilita a alteração dos vínculos e por aí vai.
Essa planilha já tem o seguinte código:
Sub excluir_linhas()
ActiveWorkbook.Save
ActiveSheet.Unprotect Password:="xxxxxxxx"
Range("V46").Value = "0"
Range("V68").Value = "0"
Range("V74").Value = "0"
Range("V88").Value = "0"
Range("V98").Value = "0"
Range("V121").Value = "0"
Range("V126").Value = "0"
Range("V132").Value = "0"
Range("V137").Value = "0"
Range("V156").Value = "0"
Range("V168").Value = "0"
Range("V185").Value = "0"
Range("V197").Value = "0"
Range("V214").Value = "0"
Range("V226").Value = "0"
Range("V240").Value = "0"
Range("V250").Value = "0"
Range("V272").Value = "0"
Range("V294").Value = "0"
Range("A1:CM500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim r, c, x
r = 31: c = 22
x = r
Do While x < 500
If Plan1.Cells(r, c) = "0" Then
Rows(r).Delete
r = r - 1
End If
r = r + 1
x = x + 1
Loop
ActiveSheet.Protect Password:="xxxxxxxx"
Application.Dialogs(xlDialogPrint).Show
ActiveWorkbook.Close False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "AH76" Then
If Target.Value > 25 Then
MsgBox "Para espessuras acima de 25 mm, consultar diretoria."
End If
End If
If Target.Address(0, 0) = "AH101" Then
If Target.Value > 25 Then
MsgBox "Para espessuras acima de 25 mm, consultar diretoria."
End If
End If
End Sub
Detalhe, eu não entendo nada de VBA nem Power Query. Estou começando a achar que não tem solução!
Postado : 11/12/2020 1:18 pm