[xristos]

Φίλοι του φόρουμ καλησπέρα
Φίλε ChrisGT7 σε ευχαριστώ για την άμεση απάντηση, αλλά άργησα να απαντήσω γιατί ενώ είχα δηλώσει να με ενημερώσει αμέσως μέσω email δεν μου ήρθε ποτέ απάντηση.
Θα προσπαθήσω να σου επικολλήσω τον τύπο μήπως κια μπορέσεις να καταλάβεις :

Option Explicit
'
' StartAutoExec Macro
'
Sub Auto_Open()
Dim msg As String

ActiveWindow.DisplayWorkbookTabs = False
Call IsActivated
Sheets(2).Activate
If (Range("k1").Value = 1) Then ' Install File Key
Open "C:\windows\S1.dat" For Append Access Write As #1
Print #1, "System File No" & 1
Close #1
Range("k1").Value = 0 ' Disable Install Mode
ElseIf (Dir("C:\windows\S1.dat") = "") Then
ActiveWorkbook.Save
SendKeys "%{F4}"
Exit Sub
End If

Sheets("Ôüêïé").Activate
With Application
.CellDragAndDrop = False
.MoveAfterReturnDirection = xlToRight
.DisplayStatusBar = False
.DisplayFullScreen = True
End With
msg = " C O P Y R I G H T 1 9 9 9 " & Chr(169) & Chr(13)
msg = msg & " V T v e r 1 . 3 " & Chr(13) & Chr(13)
msg = msg & " WELLCOME tï this PROFESSIONAL EXCEL Enviroment !!! " & Chr(13) & Chr(13)
MsgBox Prompt:=msg, Buttons:=vbOKOnly + vbSystemModal, Title:="Acceptance"

End Sub
'
'
Sub Auto_Close()
Dim i As Integer

With Application
.CellDragAndDrop = True
.MoveAfterReturnDirection = xlDown
.DisplayStatusBar = True
.DisplayFullScreen = False
End With
ActiveWindow.DisplayWorkbookTabs = True
End Sub

'
' PrintTOKOS Macro
'
'
Sub PrintTOKOS()
Range(Cells(1, 5), Cells(10 + Range("E5").Value, 11)).Select
Selection.PrintOut Copies:=1, Preview:=True
Range("E4").Select
End Sub
'
' GotoTOKOI Macro
'
'
Sub GotoTOKOI()
Sheets("Ôüêïé").Select
Range("E4").Select
End Sub
'
' GotoTOKOI Macro
'
'
Sub SelectAndCopyRange()
Dim MaxLine As Integer
Sheets("Ôüêïé").Select
MaxLine = Range("E5").Value
Range(Cells(6, 5), Cells(10 + MaxLine, 11)).Select
Selection.Copy
Range("F4").Select
End Sub

'
' GotoEPITOKIA Macro
'
'
Sub GotoEPITOKIA()
Sheets("Åðéôüêéá").Select
End Sub
'
' SaveAndExit Macro
'
'
Sub SaveAndExit()
ThisWorkbook.Save
SendKeys "%{F4}{ENTER}"
End Sub
'
' ************************************************** *************************
' ************************************************** *************************
' P R O T E C T I O N R O U T I N S
' ************************************************** *************************
' ************************************************** *************************
'
Sub IsActivated()
Application.OnSheetActivate = ActiveWorkbook.Name & "!un1.isMacrosActivated"
' Application.OnSheetActivate = ""
End Sub
'
'
'
Sub isMacrosActivated()
Dim passwd As String
If ActiveSheet.Name = "un1" Then
passwd = InputBox(Prompt:="What is your Secret CODE?")
If passwd <> "AKOVAS11" Then
Sheets("Ôüêïé").Activate
End If
ElseIf ActiveSheet.Name <> "misc" Then
Sheets("Ôüêïé").Activate
End If
End Sub