Office: Suche VBA Code

Hallo Leute,

ich bin auf der Suche nach 3 VBA Codes und absoluter VBA Anfänger

1. Zuerst benötige ich einen Code mit dem ich angeben kann das sich das Arbeitsblatt nur öffnet wenn Makros aktiviert sind. Sollte dies nicht der Fall sein, soll sich ein Fenster öffnen mit dem ich die Makros aktivieren kann.
2. Nun soll die MAC Adresse, der Benutzername und/oder der Rechnername des Rechner überprüft werden ob die Arbeitsmappe geöffnet werden darf.
3. Und zuletzt soll das anzeigen und ändern von Makros durch einen Code geschützt werden, so das dies nur mit einem Password möglich ist

Für Eure Hilfe möchte ich mich schon mal bedanken.

 

Hallo!

1. Gestaltet sich etwas schwierig, denn dein Code wird ja nur dann aufgerufen, wenn Makros schon aktiviert sind!
2. Da müssen VBA-Profis ran. (nicht meine Baustelle und VBA auf einem MAC ist sowieso versionsabhängig)
3. Im VAB-Editor kannst du dein Projekt durch ein Passwort schützen lassen. (In Excel 2010: Menü Extras > Eigenschaften von VBA-Project > Schutz)
100% sicher ist dieser Schutz allerdings nicht, aber dem kann nur Bill Gates Abhilfe schaffen...

 

Dazu schrieb Schatzi ja schon... Du bräuchtest aktivierte Makros, um zu fragen, ob die Makros aktiviert werden sollen. Das wird nix, Henne und Ei usw.

Dabei kann Dir vielleicht der Code helfen, den ich weiter unten poste. Das ist ein Modul, das ich in Access öfter verwende, aber es sollte direkt oder mit nur minimalen Anpassungen auch in Excel laufen. Der Code ist irgendwo im Netz gefunden und wahrscheinlich geringfügig von mir angepaßt worden.

Auch dazu schrieb Schatzi ja schon... Der Schutz von Excel ist wenigstens etwas, aber ganz wasserdicht ist er auch nicht. Vernünftiger Schutz ist mit einer Interpreter-Sprache auch eher schwierig. Da hilft eigentlich nur eine Compiler-Sprache, wo im kompilierten Endergebnis nicht mehr der Source-Code im Klartext enthalten ist, sondern nur noch das in Maschinensprache übersetzte Programm.

Gruß, Michael

Code:

Option Compare Database
Option Explicit

Type WKSTA_INFO_101
wki101_platform_id As Long
wki101_computername As Long
wki101_langroup As Long
wki101_ver_major As Long
wki101_ver_minor As Long
wki101_lanroot As Long
End Type
Type WKSTA_USER_INFO_1
wkui1_username As Long
wkui1_logon_domain As Long
wkui1_logon_server As Long
wkui1_oth_domains As Long
End Type

Public wsComputerName As String
Public wsLanGroup As String
Public wsUserName As String
Public wsLogonDomain As String

Declare Function WNetGetUser& Lib "Mpr" Alias "WNetGetUserA" (lpName As Any, ByVal lpUserName$, lpnLength&)
Declare Function NetWkstaGetInfo& Lib "Netapi32" (strServer As Any, ByVal lLevel&, pbBuffer As Any)
Declare Function NetWkstaUserGetInfo& Lib "Netapi32" (reserved As Any, ByVal lLevel&, pbBuffer As Any)
Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal src As Any)
Declare Sub lstrcpy Lib "kernel32" (dest As Any, ByVal src As Any)
Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal size&)
Declare Function NetApiBufferFree& Lib "Netapi32" (ByVal buffer&)

Private Function GetWorkstationInfo()
Dim ret As Long
Dim buffer(512) As Byte
Dim i As Integer
Dim wk101 As WKSTA_INFO_101
Dim pwk101 As Long
Dim wk1 As WKSTA_USER_INFO_1
Dim pwk1 As Long
Dim cbusername As Long
' Clear all of the display values.
wsComputerName = "": wsLanGroup = "": wsUserName = "": wsLogonDomain = ""
' Windows 95 or NT - call WNetGetUser to get the name of the user.
wsUserName = Space(256)
cbusername = Len(wsUserName)
ret = WNetGetUser(ByVal 0&, wsUserName, cbusername)
If ret = 0 Then
' Success - strip off the null.
wsUserName = LCase(Left(wsUserName, InStr(wsUserName, Chr(0)) - 1))
'wsUserName = Left(wsUserName, 7)
Else
wsUserName = ""
End If
'================================================================
' The following section works only under Windows NT
'================================================================
'NT only - call NetWkstaGetInfo to get computer name and lan group
ret = NetWkstaGetInfo(ByVal 0&, 101, pwk101)
RtlMoveMemory wk101, ByVal pwk101, Len(wk101)
lstrcpyW buffer(0), wk101.wki101_computername
' Get every other byte from Unicode string.
i = 0: Do While buffer(i) <> 0
wsComputerName = wsComputerName & Chr(buffer(i))
i = i + 2
Loop
lstrcpyW buffer(0), wk101.wki101_langroup
i = 0: Do While buffer(i) <> 0
wsLanGroup = wsLanGroup & Chr(buffer(i))
i = i + 2
Loop
ret = NetApiBufferFree(pwk101)
' NT only - call NetWkstaUserGetInfo.
ret = NetWkstaUserGetInfo(ByVal 0&, 1, pwk1)
RtlMoveMemory wk1, ByVal pwk1, Len(wk1)
lstrcpyW buffer(0), wk1.wkui1_logon_domain
i = 0: Do While buffer(i) <> 0
wsLogonDomain = wsLogonDomain & Chr(buffer(i))
i = i + 2
Loop
ret = NetApiBufferFree(pwk1)
'================================================================
'End NT-specific section
'================================================================
'Debug.Print wsComputerName, wsLanGroup, wsUserName, wsLogonDomain
End Function

Function GetWsUsername()
Dim ok As Long
ok = GetWorkstationInfo()
GetWsUsername = LCase(wsUserName)
End Function

Function GetWsComputername()
Dim ok As Long
ok = GetWorkstationInfo()
GetWsComputername = LCase(wsComputerName)
End Function

Function GetWsLanGroup()
Dim ok As Long
ok = GetWorkstationInfo()
GetWsComputername = LCase(wsLanGroup)
End Function

Function GetWsLogonDomain()
Dim ok As Long
ok = GetWorkstationInfo()
GetWsComputername = LCase(wsLogonDomain)
End Function

 

So, ich habe nun eine Code gefunden mit dem ich, wenn Makros nicht aktiv sind, werden alle Tabellenblätter bis auf ein Deckblatt ausgeblendet. Wenn Makros aktiv sind, werden die anderem Blätter auch angezeigt, nur das Deckblatt nicht mehr. Ist zumindest ein Anfang.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets(1).Visible = True
Sheets(2).Visible = False
Sheets(3).Visible = False
End Sub

Private Sub Workbook_Open()
Sheets(2).Visible = True
Sheets(3).Visible = True
Sheets(1).Visible = False
End Sub









Nun ist die Frage, wie muss ich den Code, den du mir gegeben hast anpassen?

 

Yep, das hilft in den meisten Fällen schon. Auf dem Deckblatt steht dann, daß man die Makros aktivieren muß und dann funktioniert das schon.

Kleine Anmerkung:

Code:

Sheets(1).Visible = True

Wenn Du daraus ein

Code:

sheets(1).visible = xlveryhidden

machst, hast Du den Kram noch etwas wasserdichter. Weil: Ein Blatt, daß auf xlveryhidden gesetzt ist, kann über das Menü "Format - Blatt - Einblenden..." nicht sichtbar gemacht werden.

Nunja, anpassen ist nicht ganz der richtige Ausdruck dafür... ;-) Du muß ihn einbinden und benutzen. Du hast dort z.B. die Routine "GetWsUsername", die Dir den Namen des Benutzers liefert. Was Du dann allerdings mit der Information machst, ist dann Deine Sache.

Gruß, Michael