Moderatori: Anthony47, Flash30005
Sub NewXL()
Dim XlApp As Object, DirDocs As String, CkF
'
Set wshshell = CreateObject("WScript.Shell")
DirDocs = wshshell.SpecialFolders("MyDocuments")
Set wshshell = Nothing
CkF = FileStatus(DirDocs & "\4WnG_ADD-FAVORITE.xlsm")
If CkF = 0 Then
Set XlApp = CreateObject("Excel.Application")
XlApp.Visible = True
XlApp.WindowState = xlNormal
XlApp.Width = 200
XlApp.Height = 200
XlApp.Workbooks.Open (DirDocs & "\4WnG_ADD-FAVORITE.xlsm")
End If
End Sub
Function FileStatus(filename As String) As Variant
'Check file status; codice di ritorno:
'0=file libero, 70=file occupato, 53=file non esiste
'76=path non esiste
'altri errori: da indagare
'
Dim filenum As Integer, errnum As Integer
'
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
FileStatus = errnum
End Function
Private Sub Workbook_Open()
Call NewXL
End Sub
Sub DelLink2()
Dim myCLnk As String, LnkPAth
Set WSShell = CreateObject("WScript.Shell")
LnkPAth = Environ("UserProfile") & "\Links\"
LnkPAth2 = Environ("UserProfile") & "\Links\Old\" '<<<<< mia aggiunta
Set WSShell = Nothing
myCLnk = Dir(LnkPAth & "AA_*")
Do
myEsito = False
If myCLnk <> "" Then
Set myLink2 = WSShell.CreateShortcut(LnkPAth & myCLink) '<<<<< mia aggiunta
myLink2.Save '<<<<< mia aggiunta
Call TrackEnd2(myCLnk)
If myEsito Then Kill LnkPAth & myCLnk
Else
Exit Do
End If
DoEvents
myCLnk = Dir
Loop
Call LinkList2
End Sub
Sub NewXL()
Dim XlApp As Object, DirDocs As String, CkF
'
Set wshshell = CreateObject("WScript.Shell")
DirDocs = wshshell.SpecialFolders("MyDocuments")
Set wshshell = Nothing
CkF = FileStatus(DirDocs & "\1.0Navigator.xlsm")
Select Case Cfk
Case 0
pippo = MsgBox("Vuoi aprire Navigator?", vbYesNo)
If pippo = vbNo Then
Exit Sub
End If
Set XlApp = CreateObject("Excel.Application")
XlApp.Visible = True
XlApp.WindowState = xlNormal
XlApp.Workbooks.Open (DirDocs & "\1.0Navigator.xlsm")
End Select
End Sub
Function FileStatus(filename As String) As Variant
'Check file status; codice di ritorno:
'0=file libero, 70=file occupato, 53=file non esiste
'76=path non esiste
'altri errori: da indagare
'
Dim filenum As Integer, errnum As Integer
'
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
FileStatus = errnum
End Function
Application.WindowState = xlMaximized
Private Sub UserForm_Activate()
Debug.Print "Via>>>>"
Me.Label2.Caption = "La form consente di Aggiungere o Eliminare voci " & vbCrLf & _
"all'interno dei preferiti di Windows"
Call LinkList
myCol1 = RGB(200, 200, 180)
myCol2 = RGB(200, 180, 200)
Me.BackColor = myCol1
Me.Label1.BackColor = myCol1
Me.Label2.BackColor = myCol1
Me.Frame1.BackColor = myCol2
Me.Label4.BackColor = myCol2
Me.Label5.BackColor = myCol2
Me.Label6.BackColor = myCol2
notN = True
Me.ComboBox1.Text = " ": Me.ComboBox1.Text = ""
DoEvents
notN = False
Me.TextBox1.SetFocus
'SendKeys "{up}" 'aggiunto marco forse conflitto con NumLock?
'SendKeys "{up}" 'aggiunto marco
End Sub
Torna a Applicazioni Office Windows
Strano messaggio dopo aggiornamento mappe navigatore Autore: usag |
Forum: Forum off-topic Risposte: 0 |
Visitano il forum: Anthony47, Raffaele53, raimea e 16 ospiti