Miałem problem z błędnie działającym kodem VBA. Problem niby nie wielki bo trzeba było zlikwidować 1 niepotrzebną linijkę kodu. Jednak trzeba to zrobić u kilkuset użytkowników w arkuszu który miał już powpisywane dane. Wysłanie nowego nie bardzo wchodziło w grę. Dodatkowo projekt był zabezpieczony hasłem.

Jednak przemyślność ludzka nie zna granic i dzięki podpowiedziom z tej, tej i tej strony udało mi się stworzyć arkusz który automatycznie zmieniał zawartość kodu!

Kod jest dość „brudny” ale skutecznie działający.
Istotne jest aby zabezpieczeniach makr zaznaczyć opcję
„Ufaj dostępowi do programu Visual Basic Project” w zakładce „Zaufani wydawcy” (Excel 2003)
i w „Tools” > „References…”
Dodać „Microsoft Visual Basic For Applications Extensibility 5.3.”


Option Explicit
'
Private Const vbext_ct_ActiveXDesigner = 11
Private Const vbext_ct_ClassModule = 2
Private Const vbext_ct_Document = 100 '(&H64)
Private Const vbext_ct_MSForm = 3
Private Const vbext_ct_StdModule = 1
'
Sub start()
Dim i As Integer 'counter of files
Dim GarageFile As String
Dim FDir, all As String
'
'wybór pliku
all="c:\jakis katalog\arkusz.xls"
Workbooks.Open Filename:=all
GarageFile = StripPathString(all, False)
'Ten wpis jest istotny jeśli wybieramy plik formatką
UnprotectVBProject Workbooks(GarageFile), "test123"
DoEvents
With Workbooks(GarageFile)
.VBProject.VBComponents.Add 1
End With
' Tu jest wywołanie zmiany linii
Call ModuleFindAndReplace("wynik = zapis(6, """")", "' zmiana lini !!!!")
'I po problemie
ActiveWorkbook.Close SaveChanges:=True
' tadam!
End Sub
'
' funkcja odblokowanie projektu nie trzeba go później zabezpieczać
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
'
Set vbProj = WB.VBProject
'
'can't do it if already unlocked!
If vbProj.Protection <> 1 Then Exit Sub
'
Set Application.VBE.ActiveVBProject = vbProj
'
' now use lovely SendKeys to quote the project password
SendKeys Password & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub
'
'
'
Public Function ModuleFindAndReplace(FindText As String, ReplaceText As String, Optional DeclarationsText As String) As Boolean
Dim objComponent As Object
Dim strTemp As String
Dim lngStartRow As Long, lngStartCol As Long, lngEndRow As Long, lngEndCol As Long
Dim i As Integer
'tu jest istotna zmiana od przykładów ze stron
'wybieram drugi projekt (lub kolejny) by nie szukać w samym sobie!!!!
With Application.VBE.VBProjects.Item(2)
For Each objComponent In .VBComponents
With objComponent.CodeModule
' ilość linii w kodzie i nazwa modułu lub formatki!
If .CountOfLines > 0 And .Name = "podsumowanie" Then
lngStartRow = 1: lngStartCol = 1
'Setting to -1 signifies last row and column
lngEndRow = -1: lngEndCol = -1
Do While .Find(FindText, lngStartRow, lngStartCol, -lngEndRow, -lngEndCol, False, False)
strTemp = .Lines(lngStartRow, 1)
strTemp = Replace(strTemp, FindText, ReplaceText)
Debug.Print objComponent.Name & " " & objComponent.Type & " start: " & lngStartRow & "," & lngStartCol & " End: " & lngEndRow & "," & lngEndCol & vbCrLf & " Before: " & .Lines(lngStartRow, 1) & vbCrLf & " After: " & strTemp
.ReplaceLine lngStartRow, strTemp
lngStartRow = lngStartRow + 1
lngStartCol = 1
Loop
End If
End With
Next objComponent
End With
Set objComponent = Nothing
End Function
'
' Bonusowa funkcja która zwraca ze ścieżki samą nazwę pliku
' Znaleziona gdzieś w internecie
'
Function StripPathString(ByVal Path As String, ByVal StripFileName As Boolean) As String
Dim X As Integer, Ct As Integer, Y As Integer
StripPathString = Path
X = InStr(Path, "\")
Do While X
Ct = X
X = InStr(Ct + 1, Path, "\")
Loop
' tu wprowadziłem zmiany
If Ct > 0 Then
Select Case StripFileName
Case False
StripPathString = Mid(Path, Ct + 1)
Case True
Y = InStr(Path, Mid(Path, Ct + 1))
StripPathString = Mid(Path, 1, Y - 1)
End Select
Else
StripPathString = ""
End If
End Function


Cała zabawa zaoszczędziła mi mnóstwo problemów.

Od jakiegoś czasu wkurzał mnie komunikat „Wykonanie serwera nie powiodło się” pojawiający się w „Centrum sieci i udostępniania”.
Okazało się że powodem był brak użytkowników „USŁUGA LOKALNA” i „USŁUGA SIECIOWA” w grupie administratorzy.
Objawia się to między innymi błędami
podobnymi do tych (wersja angielska)

Failed to initialize all required WMI classes:
Win32_Processor: Win32: Access is denied
Win32_WMISetting: Successful
Security information: Successful
WIN32_OperatingSystem: Win32: Access is denied

we „Właściwości” po otworzeniu zakładki „Panel sterowania” > „Zarządzanie komputerem” > „Sterowanie usługa WMI”

Udało mi się tego pozbyć wykonując w konsolo CMD

net localgroup Administratorzy /add "USŁUGA LOKALNA"
net localgroup Administratorzy /add "USŁUGA SIECIOWA"

Trzeba zrestartować system i powinno zadziałać.

Po restarcie komenda

net localgroup Administratorzy

powinni pokazać coś w podobie:

Nazwa aliasu Administratorzy
Komentarz Administratorzy mają pełny i nieograniczony dostęp do komputera/domeny
Członkowie
-------------------------------------------------------------------------------
Administrator
Marek Olszewski
ZARZĄDZANIE NT\USŁUGA
ZARZĄDZANIE NT\USŁUGA LOKALNA
ZARZĄDZANIE NT\USŁUGA SIECIOWA
Polecenie zostało wykonane pomyślnie.