DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Kodları windows/system32 klsaörüne göre ayarladım.Üstadım bir dosya buldum ama işinizi görür mü bilemiyorum.
[URL="http://www.vbaexpress.com/kb/default.php?action=13&kb_id=447&PHPSESSID=5d7620e4b182a5dd3173ecf44b29ae09"]Install ActiveX.zip 349.67KB[/url]
Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, _
ByVal wParam As Any, ByVal lParam As Any) As Long
'
Const ERROR_SUCCESS = &H0
Const MyOCX As String = "C:\Winnt\System32\msdxm.ocx"
'
Sub RegOCX()
If Dir(MyOCX) = Empty Then
MsgBox MyOCX & " bulunamadı, dosya yolunu kontrol edin.... !"
Else
Call RegisterServer(MyOCX, True)
End If
End Sub
'
Sub UnRegOCX()
If Dir(MyOCX) = Empty Then
MsgBox MyOCX & " bulunamadı, dosya yolunu kontrol edin.... !"
Else
Call RegisterServer(MyOCX, False)
End If
End Sub
'
Function RegisterServer(pathOCX As String, Register As Boolean)
Dim ProcAddr As Long
On Error Resume Next
If Register = True Then
ProcAddr = GetProcAddress(LoadLibrary(pathOCX), "DllRegisterServer")
Else
ProcAddr = GetProcAddress(LoadLibrary(pathOCX), "DllUnregisterServer")
End If
If CallWindowProc(ProcAddr, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&) = ERROR_SUCCESS Then
MsgBox IIf(Register = True, "Registration", "Unregistration") & " Basarili oldu !"
Else
MsgBox IIf(Register = True, "Registration", "Unregistration") & " Basarili olmadi"
End If
FreeLibrary LoadLibrary(pathOCX)
End Function
Sub Register()
Shell "RegSvr32 /s" & "D:\Excel Programlama\extra\OCX\actskn43.ocx"
End Sub
Sub UnRegister()
Shell "RegSvr32 /s /u" & "D:\Excel Programlama\extra\OCX\actskn43.ocx"
End Sub
Dim soru As String
soru = GetSetting("program", "actskn43", "cevap")
If soru = vbNullString Then
Shell "RegSvr32 /s" & "D:\Excel Programlama\extra\OCX\actskn43.ocx"
SaveSetting "program", "actskn43", "cevap", "1"
Else
MsgBox "Dosya Zaten Register Edilmiş .."
End If
Sub Register()
Shell "RegSvr32 /s" & "D:\Excel Programlama\extra\OCX\actskn43.ocx"
End Sub
Sub UnRegister()
Shell "RegSvr32 /s /u" & "D:\Excel Programlama\extra\OCX\actskn43.ocx"
End Sub
Zeki bey dtpickeri kaldırıp kurmak istedim ama unreg olmuyor.Eğer dosya yolu gerçekse problem çıkması gerekir. Bu durum klsör isminin boşluk içermesinden kaynaklanıyor.Kod:Sub Register() Shell "RegSvr32 /s" & "D:\Excel Programlama\extra\OCX\actskn43.ocx" End Sub Sub UnRegister() Shell "RegSvr32 /s /u" & "D:\Excel Programlama\extra\OCX\actskn43.ocx" End Sub
Dosya yoluna eklenecek iki çift tırnak sorunu ortadan kaldırır.
Shell "RegSvr32 /s /u" & "C:\Windows\system32\MSCOMCT2.OCX"
Shell "RegSvr32 /s /u" & [COLOR=Blue][B]" C[/B][/COLOR]:\Windows\system32\MSCOMCT2.OCX"
Evet bu oldu teşekkürler.Bir boşluk gerekiyor.
Kod:Shell "RegSvr32 /s /u" & [COLOR=Blue][B]" C[/B][/COLOR]:\Windows\system32\MSCOMCT2.OCX"