Haluk
Özel Üye
- Katılım
- 7 Temmuz 2004
- Mesajlar
- 12,406
- Excel Vers. ve Dili
-
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
- Altın Üyelik Bitiş Tarihi
- ∞
Merhaba;
Sıkıntıdan MS Access'i biraz kurcaladım bu akşam ... :mrgreen:
[vb:1:6c9e930dd2]'****************************************************
'* MS Access programinda arac cubuklarindaki *
'* kontrollerin adlari ve ID'lerini bulup, *
'* bir NotePad dosyasina yazdiktan sonra *
'* kisa yolunu MasaUstu' ne yerlestiren *
'* bir kod calismasidir. *
'* *
'* Burasi Excel Vadisi ... *
'* Haluk ® *
'* 03/10/2005 *
'* *
'****************************************************
Option Compare Database
'
Sub CommandBarControlID()
Dim Header1 As String * 5
Dim Header2 As String * 38
Dim Header3 As String * 10
Dim Capt As String * 30
Dim WinScrObj As Object, MyShortCut As Object
Dim MyFolder As String, MyFile As String
Dim TargPath As String
TargPath = "C:\MS-AccessControlsID.txt"
MyFile = "MS-AccessControlsID.txt"
Header1 = "No"
Header2 = "Kontrol"
Header3 = "ID"
Open TargPath For Output As #1
Print #1, Header1; Header2; Header3
Print #1, String(50, "-")
Print #1,
For Each Ctrl In CommandBars.FindControls
i = i + 1
Capt = Replace(Ctrl.Caption, "&", "")
CtrlId = Ctrl.ID
Print #1, i & ") "; Capt, CtrlId
Next
Close #1
Set WinScrObj = CreateObject("WScript.Shell")
MyFolder = WinScrObj.SpecialFolders("DeskTop")
Set MyShortCut = WinScrObj.CreateShortcut _
(MyFolder & "\" & MyFile & ".lnk")
With MyShortCut
.TargetPath = WinScrObj.ExpandEnvironmentStrings(TargPath)
.WorkingDirectory = WinScrObj.ExpandEnvironmentStrings(TargPath)
.WindowStyle = 4
.IconLocation = WinScrObj.ExpandEnvironmentStrings(TargPath & ", 0")
.Save
End With
MsgBox "Masaustune dosya icin kisa yol olusturuldu ...", vbInformation, "Rapor !"
Set WinScrObj = Nothing
Set MyShortCut = Nothing
End Sub[/vb:1:6c9e930dd2]
Sıkıntıdan MS Access'i biraz kurcaladım bu akşam ... :mrgreen:
[vb:1:6c9e930dd2]'****************************************************
'* MS Access programinda arac cubuklarindaki *
'* kontrollerin adlari ve ID'lerini bulup, *
'* bir NotePad dosyasina yazdiktan sonra *
'* kisa yolunu MasaUstu' ne yerlestiren *
'* bir kod calismasidir. *
'* *
'* Burasi Excel Vadisi ... *
'* Haluk ® *
'* 03/10/2005 *
'* *
'****************************************************
Option Compare Database
'
Sub CommandBarControlID()
Dim Header1 As String * 5
Dim Header2 As String * 38
Dim Header3 As String * 10
Dim Capt As String * 30
Dim WinScrObj As Object, MyShortCut As Object
Dim MyFolder As String, MyFile As String
Dim TargPath As String
TargPath = "C:\MS-AccessControlsID.txt"
MyFile = "MS-AccessControlsID.txt"
Header1 = "No"
Header2 = "Kontrol"
Header3 = "ID"
Open TargPath For Output As #1
Print #1, Header1; Header2; Header3
Print #1, String(50, "-")
Print #1,
For Each Ctrl In CommandBars.FindControls
i = i + 1
Capt = Replace(Ctrl.Caption, "&", "")
CtrlId = Ctrl.ID
Print #1, i & ") "; Capt, CtrlId
Next
Close #1
Set WinScrObj = CreateObject("WScript.Shell")
MyFolder = WinScrObj.SpecialFolders("DeskTop")
Set MyShortCut = WinScrObj.CreateShortcut _
(MyFolder & "\" & MyFile & ".lnk")
With MyShortCut
.TargetPath = WinScrObj.ExpandEnvironmentStrings(TargPath)
.WorkingDirectory = WinScrObj.ExpandEnvironmentStrings(TargPath)
.WindowStyle = 4
.IconLocation = WinScrObj.ExpandEnvironmentStrings(TargPath & ", 0")
.Save
End With
MsgBox "Masaustune dosya icin kisa yol olusturuldu ...", vbInformation, "Rapor !"
Set WinScrObj = Nothing
Set MyShortCut = Nothing
End Sub[/vb:1:6c9e930dd2]
