Makro Kod Listesi

Excel de kullanılan Makro Kodlarının Listesi

ID : 1515
ISLEM : menü ekleme
MAKRO KODU : Thisworkbooka Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Application.CommandBars("Symbolleiste_Klaus").Delete End Sub Private Sub Workbook_Open() On Error Resume Next Application.CommandBars.Add(Name:="Symbolleiste_Klaus").Visible = True Set myControl1 = Application.CommandBars("Symbolleiste_Klaus").Controls.Add(msoControlButton) With myControl1 .FaceId = 71 'HIER FACE-ID ANPASSEN .OnAction = "Klaus1" 'HIER DEINEN MAKRONAMEN ANPASSEN .Caption = "Klaus´ Makro 1" 'HIER DEINEN INFOTEXT ANPASSEN End With Set myControl2 = Application.CommandBars("Symbolleiste_Klaus").Controls.Add(msoControlButton) With myControl2 .FaceId = 72 'HIER FACE-ID ANPASSEN .OnAction = "Klaus2" 'HIER DEINEN MAKRONAMEN ANPASSEN .Caption = "Klaus´ Makro 2" 'HIER DEINEN INFOTEXT ANPASSEN End With End Sub 'Modüle Sub Klaus1() MsgBox "http://www.excel-lex.de.vu" End Sub Sub Klaus2() MsgBox "http://www.kmbuss.de" End Sub

ID : 1516
ISLEM : menü ekleme ve silme
MAKRO KODU : Sub Menue_ein() Set ML = Application.CommandBars("Worksheet Menu Bar") ' Name für neues Menü anlegen Set U1 = ML.Controls.Add(Type:=msoControlPopup, Before:=10) U1.Caption = "&EXCEL-LEX" U1.Tag = "MeinMenü" ' dient zur eindeutigen Identifizierung des Menüs ' 1. Menüpunkt anlegen Set Punkt = U1.Controls.Add(Type:=msoControlButton) With Punkt .Caption = "&1. Menüpunkt" .OnAction = "MsgBox1" .Style = msoButtonIconAndCaption .FaceId = 3278 End With ' neues Untermenü wird hinzugefügt Set Punkt = U1.Controls.Add(Type:=msoControlPopup) With Punkt .Caption = "1.Untermenü" End With Set U2 = Punkt ' Variable für das 2. Untermenü wird gesetzt ' Neuer Menüeintrag im 2.Untermenü Set Punkt = U2.Controls.Add(Type:=msoControlButton) With Punkt .Caption = "&2.Menüpunkt" .OnAction = "MsgBox2" .Style = msoButtonIconAndCaption .FaceId = 488 End With Set Punkt = U2.Controls.Add(Type:=msoControlButton) With Punkt .Caption = "&3.Menüpunkt" .OnAction = "MsgBox3" .Style = msoButtonIconAndCaption .FaceId = 1715 End With ' Weiterer Eintrag im 1.Untermenü Set Punkt = U1.Controls.Add(Type:=msoControlButton) With Punkt .Caption = "&4.Menüpunkt" .OnAction = "MsgBox4" .Style = msoButtonIconAndCaption .FaceId = 3200 End With End Sub Sub Menue_aus() Set ML = Application.CommandBars("Worksheet Menu Bar") On Error Resume Next ' Fehlerbehandlung ML.FindControl(Tag:="MeinMenü").Delete End Sub

ID : 1517
ISLEM : menü ekleme ve silme
MAKRO KODU : Private Sub Workbook_Open() Dim cbMenu As CommandBar Dim cbSpecialMenu As CommandBarPopup Dim cbCommand As CommandBarControl Set cbMenu = Application.CommandBars("Worksheet Menu Bar") Set cbSpecialMenu = cbMenu.Controls.Add(Type:=msoControlPopup) cbSpecialMenu.Caption = "Mein Spezialmenu" Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton) cbCommand.Caption = "Mein Befehl" cbCommand.OnAction = "sil" End Sub Sub sil() Dim cbSpecialMenu As CommandBarControl On Error Resume Next Set cbSpecialMenu = Application.CommandBars("Worksheet Menu Bar").Controls("Mein Spezialmenu") cbSpecialMenu.Delete End Sub

ID : 1518
ISLEM : menü index numaraları
MAKRO KODU : Sub ID_anzeigen() Dim intZ%, objY As CommandBar, objX As CommandBarControl [a1] = "ID": [b1] = "Name": [c1] = "Index": [d1] = "Symbolleiste" intZ = 2 For Each objY In CommandBars For Each objX In CommandBars(objY.Name).Controls Cells(intZ, 1) = objX.ID Cells(intZ, 2) = objX.Caption Cells(intZ, 3) = objX.Index Cells(intZ, 4) = objY.Name intZ = intZ + 1 Next Next End Sub

ID : 1519
ISLEM : menü olarak saat ekleme (en güvenilir)
MAKRO KODU : Sayfaların kod bölümüne ve Thisworkbooka Option Explicit 'Modüle1 e Option Explicit Sub StartClock() StartClockinMenu End Sub Sub StopClock() StopClockinMenu End Sub 'Modüle2 ye Option Explicit Private Declare Function FindWindow _ Lib "user32" _ Alias "FindWindowA" _ ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String _ ) _ As Long Private Declare Function SetTimer _ Lib "user32" _ ( _ ByVal hWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long _ ) _ As Long Private Declare Function KillTimer _ Lib "user32" _ ( _ ByVal hWnd As Long, _ ByVal nIDEvent As Long _ ) _ As Long Private Declare Function GetCurrentVbaProject _ Lib "vba332.dll" _ Alias "EbGetExecutingProj" _ ( _ hProject As Long _ ) _ As Long Private Declare Function GetFuncID _ Lib "vba332.dll" _ Alias "TipGetFunctionId" _ ( _ ByVal hProject As Long, _ ByVal strFunctionName As String, _ ByRef strFunctionID As String _ ) _ As Long Private Declare Function GetAddr _ Lib "vba332.dll" _ Alias "TipGetLpfnOfFunctionId" _ ( _ ByVal hProject As Long, _ ByVal strFunctionID As String, _ ByRef lpfnAddressOf As Long _ ) _ As Long Private WindowsTimer As Long Private ClockCBControl As CommandBarButton Sub StartClockinMenu() Set ClockCBControl = _ Application.CommandBars(1).Controls.Add( _ Type:=msoControlButton, Temporary:=True) ClockCBControl.Style = msoButtonCaption ClockCBControl.Caption = Format(Now, "Long Time") fncWindowsTimer 1000 End Sub Sub StopClockinMenu() fncStopWindowsTimer ClockCBControl.Delete End Sub Private Function fncWindowsTimer( _ TimeInterval As Long _ ) As Boolean Dim WindowsTimer As Long WindowsTimer = 0 If Val(Application.Version) > 8 Then WindowsTimer = SetTimer _ ( _ hWnd:=FindWindow("XLMAIN", Application.Caption), _ nIDEvent:=0, _ uElapse:=TimeInterval, _ lpTimerFunc:=AddrOf_cbkCustomTimer _ ) Else WindowsTimer = SetTimer _ ( _ hWnd:=FindWindow("XLMAIN", Application.Caption), _ nIDEvent:=0, _ uElapse:=TimeInterval, _ lpTimerFunc:=AddrOf("cbkCustomTimer") _ ) End If fncWindowsTimer = CBool(WindowsTimer) End Function Private Function fncStopWindowsTimer() KillTimer _ hWnd:=FindWindow("XLMAIN", Application.Caption), _ nIDEvent:=WindowsTimer End Function Private Function cbkCustomTimer _ ( _ ByVal Window_hWnd As Long, _ ByVal WindowsMessage As Long, _ ByVal EventID As Long, _ ByVal SystemTime As Long _ ) _ As Long Dim CurrentTime As String On Error Resume Next ClockCBControl.Caption = Format(Now, "Long Time") End Function Private Function AddrOf _ ( _ CallbackFunctionName As String _ ) _ As Long Dim aResult As Long Dim CurrentVBProject As Long Dim strFunctionID As String Dim AddressOfFunction As Long Dim UnicodeFunctionName As String UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode) If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then aResult = GetFuncID _ ( _ hProject:=CurrentVBProject, _ strFunctionName:=UnicodeFunctionName, _ strFunctionID:=strFunctionID _ ) If aResult = 0 Then aResult = GetAddr _ ( _ hProject:=CurrentVBProject, _ strFunctionID:=strFunctionID, _ lpfnAddressOf:=AddressOfFunction _ ) If aResult = 0 Then AddrOf = AddressOfFunction End If End If End If End Function Private Function AddrOf_cbkCustomTimer() As Long AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer) End Function Private Function vbaPass(AddressOfFunction As Long) As Long vbaPass = AddressOfFunction End Function

ID : 1520
ISLEM : menülerin ingilizce ve türkçeleri
MAKRO KODU : Public Sub Me_006() Dim CmdB As CommandBar Dim i As Integer 'Dim i% i = 1 With ActiveSheet .[A:B].ClearContents .[A1].Value = "Name" .[B1].Value = "Lokaler Name" End With For Each CmdB In Application.CommandBars If CmdB.Type = msoBarTypeNormal Then i = i + 1 With ActiveSheet .Cells(i, 1).Value = CmdB.Name .Cells(i, 2).Value = CmdB.NameLocal End With End If Next CmdB ActiveSheet.Columns("A:B").AutoFit End Sub

ID : 1521
ISLEM : mesaj alt alta birleştirme
MAKRO KODU : Sub TwoLines() MsgBox "Line 1" & vbCrLf & "Line 2" End Sub

ID : 1522
ISLEM : mesaj ile saati öğrenme
MAKRO KODU : Sub Heure() Dim i As Byte For i = 0 To 23 Application.OnTime TimeValue(i & ":00:00"), "Affiche_Heure" Next i End Sub Sub Affiche_Heure() MsgBox "Il est " & Time End Sub

ID : 1523
ISLEM : mesaj kutusu caption
MAKRO KODU : Sub mesaj() MsgBox "İyisinizdir İnşaallah", , "nasılsınız" End Sub

ID : 1524
ISLEM : mesaj kutusu çift satırlı 1
MAKRO KODU : MsgBox "Mesaj boxlarda satır başı yapamıyorum." & vbCrlf & "Bunun bir yolu olmalı !" & vbCrlf & "Acaba vbCrlf kullanırsam ne olur?", vbinformation

ID : 1525
ISLEM : mesaj kutusu çift satırlı 2
MAKRO KODU : Yada Alt+Enter'in Ascii kodu olan chr(10) kullanılabilir. Sub A() MsgBox "A" & Chr(10) & "B" & Chr(10) & "C" & Chr(10) & "D" & Chr(10) End Sub

ID : 1526
ISLEM : mesaj kutusu çift satırlı 3
MAKRO KODU : Sub MsgAscii() Dim sayi1 As Integer For sayi1 = 1 To 255 msg = msg & (sayi1) & Chr(58) & Chr(sayi1) & Space(1) Next sayi1 MsgBox msg, 64, Chr(83) & Chr(252) & Chr(108) & Chr(101) _ & Chr(121) & Chr(109) & Chr(97) & Chr(110) & Chr(32) & Chr(85) _ & Chr(90) & Chr(85) & Chr(78) & Chr(75) & Chr(214) & Chr(80) & _ Chr(82) & Chr(220) End Sub

ID : 1527
ISLEM : mesaj kutusu ile sayfa yazdırma adedi gir (sayfa boş bile olsa yazdırır)
MAKRO KODU : Sub Changing_Section_Headers() Dim c As Range, rngSection As Range Dim cFirst As Range, cLast As Range Dim rowLast As Long, colLast As Integer Dim r As Long, iSection As Integer Dim iCopies As Variant Dim strCH As String Set c = Range("A1").SpecialCells(xlCellTypeLastCell) rowLast = c.Row colLast = c.Column iCopies = InputBox( _ "Number of Copies", "Changing Section Headers", 1) If iCopies = "" Then Exit Sub Set cFirst = Range("A1") ' initialization start cell For r = 2 To rowLast ' from first row to last row If ActiveSheet.Rows(r).PageBreak = xlPageBreakManual Then Set cLast = Cells(r - 1, colLast) Set rngSection = Range(cFirst, cLast) iSection = iSection + 1 Select Case iSection ' substitute your CenterSection Header data ... Case 1: strCH = "Section 1" Case 2: strCH = "Section 2" ' etc ' Case n: strCH = "Section n" End Select ActiveSheet.PageSetup.CenterHeader = strCH rngSection.PrintOut _ Copies:=iCopies, Collate:=True Set cFirst = Cells(r, 1) End If Next r ' Last Section ++++++++++++++++++++++++++++ Set rngSection = Range(cFirst, c) iSection = iSection + 1 ' substitute your Center Header data ... strCH = "Last Section ..." ' or strCH = "Section " & iSection ActiveSheet.PageSetup.CenterHeader = strCH rngSection.PrintOut _ Copies:=iCopies, Collate:=True End Sub

ID : 1528
ISLEM : mesaj kutusu örnekleri
MAKRO KODU : Sub MyMessage() MsgBox "Merhaba 1" MsgBox "Merhaba 2", vbInformation MsgBox "Merhaba 3", vbExclamation, "Burası Başlık Kısmı" MsgBox "Merhaba 4", vbCritical, "Burası Başlık Kısmı" MsgBox "Merhaba 5", vbDefaultButton1 MsgBox "Merhaba 6", vbDefaultButton2 MsgBox "Merhaba 7", vbDefaultButton3 MsgBox "Merhaba 8", vbDefaultButton4 MsgBox "Merhaba 9", vbMsgBoxHelpButton MsgBox "Merhaba 10", vbApplicationModal MsgBox "Merhaba 11", vbMsgBoxRight MsgBox "Merhaba 12", vbMsgBoxRtlReading MsgBox "Merhaba 13", vbMsgBoxSetForeground MsgBox "Merhaba 14", vbOKCancel MsgBox "Merhaba 15", vbOKOnly MsgBox "Merhaba 16", vbQuestion MsgBox "Merhaba 17", vbRetryCancel MsgBox "Merhaba 18", vbSystemModal MsgBox "Merhaba 19", vbYesNo MsgBox "Merhaba 20", vbYesNoCancel End Sub

ID : 1529
ISLEM : mesaj kutusunda evet hayır a makro atama
MAKRO KODU : Sub msg_yes_no() iResult = MsgBox("Evet mi, Hayır mı?", vbYesNo) If iResult = vbYes Then 'Evet için buraya kod yazabilirsiniz MsgBox "Evet i seçtin" Else 'Hayır için buraya kod yazabilirsiniz MsgBox "Hayır ı seçtin" End If End Sub

ID : 1530
ISLEM : mesaj kutusunda gün, tarih, saat
MAKRO KODU : Sub MsgBox() Dim WshShell Dim intAntwort As Integer Set WshShell = CreateObject("WScript.Shell") intAntwort = WshShell.Popup(WeekdayName(Weekday(Date, vbMonday)) _ & Chr(13) & _ Day(Date) & ". " & _ MonthName(Month(Date)) & " " & _ Year(Date) & Chr(13) & _ Time, 3, "pir") End Sub

ID : 1501
ISLEM : makroyla buton eklemek
MAKRO KODU : Sub butonekle() ActiveSheet.Buttons.Add(10, 5, 50, 20).Select Selection.OnAction = "Makro1" End Sub

ID : 1502
ISLEM : makroyla email gönderme
MAKRO KODU : Sub sayfa_send() ActiveSheet.Select ActiveSheet.Copy ActiveWorkbook.SaveAs Filename:="c:\Part of " & ThisWorkbook.Name & " " & strdate ActiveSheet.Cells.Copy ActiveSheet.Cells.PasteSpecial xlPasteValues ActiveSheet.Cells.ClearComments ActiveSheet.Buttons.Delete ActiveSheet.Range(Columns(71), Columns(256)).Delete ActiveWorkbook.Save ActiveWorkbook.SendMail "serdarguyuk@dianatravel.com.tr", "CAR HİRE" fname = ActiveWorkbook.FullName ActiveWorkbook.Close Kill fname End Sub

ID : 1503
ISLEM : makroyu çaliştiran makro
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target = "AHMET" Then Run "Module1.Makro3" End If End Sub

ID : 1504
ISLEM : makroyu makro içinden çağırmak için
MAKRO KODU : bir makronun içinden başka bir makroyu çağırmak için Application.Run "kitap1.xls'!Sayfa1.baskamakro" gibi bir komut kullanabilirsiniz:

ID : 1505
ISLEM : makroyu makro içinden çağırmak için 2
MAKRO KODU : run ("denememakrosu") şeklindede olabilir:

ID : 1506
ISLEM : masaüstündeki xls uzantılıları yazar
MAKRO KODU : Sub MostRecent() Dim J As Integer For J = 1 To Application.RecentFiles.Count Cells(J, 1) = Application.RecentFiles(J).Name Next J End Sub

ID : 1507
ISLEM : masaüstüne ikon oluşturma
MAKRO KODU : Thisworkbooka 'Private Sub Workbook_Open() ' Call DShortCut(ThisWorkbook.FullName) 'End Sub 'Modüle Sub Dektop_Icon_anlegen() Call DShortCut(ThisWorkbook.FullName) End Sub Function DShortCut(strFullFilePathName As String) As Long ' Ursprüngliche Version von Myrna Larson in VBS ' Für VBA umgebaut von klausimausi64 ' Uses the Windows Scripting Host to create a .lnk ' shortcut on the user's desktop. ' Parameters: strFullFilePathName - String - The full name of ' the file to which the shortcut will point. ' Returns: 1 = success, 0 = target doesn't exist, -1 = other error ' Example: Call DShortCut ("C:\Program Files\Microsoft Office 97\Office\Examples\SAMPLES.XLS") Dim WSHShell As Object Dim WSHShortcut As Object Dim strDesktopPath As String Dim strFileName As String Dim strPath As String On Error GoTo ErrHandler ' Create a Windows Shell Object Set WSHShell = CreateObject("wscript.Shell") ' Get the file's name and path... strFileName = Dir(strFullFilePathName) strPath = Left(strFullFilePathName, Len(strFullFilePathName) - Len(strFileName)) ' Make sure file exists If Not Len(strFileName) = 0 Then ' Read desktop path using WshSpecialFolders object strDesktopPath = WSHShell.SpecialFolders.Item("Desktop") ' Create a shortcut object on the desktop Set WSHShortcut = WSHShell.CreateShortcut(strDesktopPath & "\" & strFileName & ".lnk") ' Set shortcut object properties and save it With WSHShortcut .TargetPath = WSHShell.ExpandEnvironmentStrings(strFullFilePathName) .WorkingDirectory = WSHShell.ExpandEnvironmentStrings(strPath) .WindowStyle = 4 .IconLocation = WSHShell.ExpandEnvironmentStrings(Application.Path & "\excel.exe , 0") .Save End With DShortCut = 1 Else DShortCut = 0 End If Continue: Set WSHShell = Nothing Exit Function ErrHandler: DShortCut = -1 Resume Continue End Function

ID : 1508
ISLEM : masaüstüne kısayol oluşturma iconlu
MAKRO KODU : Sub Dektop_Icon_anlegen() Call DShortCut(ThisWorkbook.FullName) End Sub Function DShortCut(strFullFilePathName As String) As Long Dim WSHShell As Object Dim WSHShortcut As Object Dim strDesktopPath As String Dim strFileName As String Dim strPath As String On Error GoTo ErrHandler ' Create a Windows Shell Object Set WSHShell = CreateObject("wscript.Shell") ' Get the file's name and path... strFileName = Dir(strFullFilePathName) strPath = Left(strFullFilePathName, Len(strFullFilePathName) - Len(strFileName)) ' Make sure file exists If Not Len(strFileName) = 0 Then ' Read desktop path using WshSpecialFolders object strDesktopPath = WSHShell.SpecialFolders.Item("Desktop") ' Create a shortcut object on the desktop Set WSHShortcut = WSHShell.CreateShortcut(strDesktopPath & "\" & strFileName & ".lnk") ' Set shortcut object properties and save it With WSHShortcut .TargetPath = WSHShell.ExpandEnvironmentStrings(strFullFilePathName) .WorkingDirectory = WSHShell.ExpandEnvironmentStrings(strPath) .WindowStyle = 4 .IconLocation = WSHShell.ExpandEnvironmentStrings(Application.Path & "\excel.exe , 0") .Save End With DShortCut = 1 Else DShortCut = 0 End If Continue: Set WSHShell = Nothing Exit Function ErrHandler: DShortCut = -1 Resume Continue End Function

ID : 1509
ISLEM : maskeleme kodu
MAKRO KODU : Private sub userform activate Dim control For each control In form1.controls If TypeOf control Is MaskEdBox Then control.Mask= “##/##/####” Next End sub

ID : 1510
ISLEM : menu ve komutları etkin, seçilebilir
MAKRO KODU : Sub menükomutlarıaç() Dim Ctrl As Office.CommandBarControl For Each Ctrl In Application.CommandBars.FindControls(Id:=847) Ctrl.Enabled = True 'True menüleri aktif yapar Next Ctrl For Each Ctrl In Application.CommandBars.FindControls(Id:=889) Ctrl.Enabled = True 'True menüleri aktif yapar Next Ctrl End Sub

ID : 1511
ISLEM : menu ve komutlarının iptali, seçilemez
MAKRO KODU : Sub menükomutlarıiptal() Dim Ctrl As Office.CommandBarControl For Each Ctrl In Application.CommandBars.FindControls(Id:=847) Ctrl.Enabled = False 'True menüleri aktif yapar Next Ctrl For Each Ctrl In Application.CommandBars.FindControls(Id:=889) Ctrl.Enabled = False 'True menüleri aktif yapar Next Ctrl End Sub

ID : 1512
ISLEM : menü çubuğunu ve tam ekranı gizle
MAKRO KODU : Sub Düğme1_Tıklat() Application.CommandBars.ActiveMenuBar.Enabled = True Application.DisplayFullScreen = True Application.CommandBars("Full Screen").Enabled = False End Sub

ID : 1513
ISLEM : menü çubuğunun silinmesi ve özel bir menünün oluşturulması
MAKRO KODU : Sub Auto_Open() a = MenuBars(xlWorksheet).Menus.Count For i = a To 1 Step -1 MenuBars(xlWorksheet).Menus(i).Delete Next Dim AnaMenü As CommandBarControl, AnaAltMenü As CommandBarControl Sheets("Sayfa1").Select Range("a1").Select '.................................................................................................... 'Ana Menüye Menü ekler Set AnaMenü = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True) With AnaMenü .Caption = "&Bordro" .Tag = "MyTag" .BeginGroup = False End With If AnaMenü Is Nothing Then Exit Sub '.................................................................................................... 'Alt Menü 1 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Sabit Bilgi Tanımlamaları" End With 'Kurum Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Kurum Bilgileri" .OnAction = "kurbil" .Style = msoButtonIconAndCaption .FaceId = 1976 .State = msoButtonUp End With 'Ekders Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Ekders Bilgileri" .OnAction = "ekderbil" .Style = msoButtonIconAndCaption .FaceId = 1979 .State = msoButtonUp End With 'Nakit Fişi Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Nakit Fişi Bilgileri" .OnAction = "nakfisbil" .Style = msoButtonIconAndCaption .FaceId = 44 .State = msoButtonUp End With 'Sendika Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Sendika Bilgileri" .OnAction = "senbil" .Style = msoButtonIconAndCaption .FaceId = 1980 .State = msoButtonUp End With 'Özel Gider İndirimi/İlaç Kesintisi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Özel Gider İndirimi/İlaç Kesintisi" .OnAction = "ozgidkes" .Style = msoButtonIconAndCaption .FaceId = 1987 .State = msoButtonUp End With 'Tazminat İsimleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tazminat İsimleri" .OnAction = "tazis" .Style = msoButtonIconAndCaption .FaceId = 1981 .State = msoButtonUp End With 'Maaş Katsayı Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maaş Katsayı Bilgileri" .OnAction = "maaskatbil" .Style = msoButtonIconAndCaption .FaceId = 1982 .State = msoButtonUp End With 'Fark Katsayı Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Fark Katsayı Bilgileri" .OnAction = "farkatbil" .Style = msoButtonIconAndCaption .FaceId = 1983 .State = msoButtonUp End With 'Gösterge Katsayı Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Gösterge Katsayı Bilgileri" .OnAction = "goskatbil" .Style = msoButtonIconAndCaption .FaceId = 1984 .State = msoButtonUp End With 'Emekli Tazminat Oranları With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Emekli Tazminat Oranları" .OnAction = "emetazor" .Style = msoButtonIconAndCaption .FaceId = 1985 .State = msoButtonUp End With 'Lojman Taminat Tutarları With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Lojman Taminat Tutarları" .OnAction = "lojtaztut" .Style = msoButtonIconAndCaption .FaceId = 1016 .State = msoButtonUp End With 'Gelir Vergisi Dilimleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Gelir Vergisi Dilimleri" .OnAction = "gelverdil" .Style = msoButtonIconAndCaption .FaceId = 1977 .State = msoButtonUp End With 'Yabancı Dil Tazminatı With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yabancı Dil Tazminatı" .OnAction = "yabdiltaz" .Style = msoButtonIconAndCaption .FaceId = 1988 .State = msoButtonUp End With 'Sakatlık İndirimleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Sakatlık İndirimleri" .OnAction = "sakind" .Style = msoButtonIconAndCaption .FaceId = 1995 .State = msoButtonUp End With 'Tayın Bedelleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tayın Bedelleri" .OnAction = "taybed" .Style = msoButtonIconAndCaption .FaceId = 1996 .State = msoButtonUp End With 'Ünvan/Taziminat Bilgileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Ünvan/Taziminat Bilgileri" .OnAction = "untazbed" .Style = msoButtonIconAndCaption .FaceId = 1997 .State = msoButtonUp End With 'Özel Kesinti İsimleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Özel Kesinti İsimleri" .OnAction = "ozkesis" .Style = msoButtonIconAndCaption .FaceId = 1992 .State = msoButtonUp End With 'Diğer Kesinti İsimleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Diğer Kesinti İsimleri" .OnAction = "dikesis" .Style = msoButtonIconAndCaption .FaceId = 1993 .State = msoButtonUp End With 'Anlaşmalı Eczaneler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Anlaşmalı Eczaneler" .OnAction = "anecz" .Style = msoButtonIconAndCaption .FaceId = 1994 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 2 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Memur Bilgileri Girişi" End With '.................................................................................................... 'Alt Menü 3 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Hesaplama İşlemleri ve Sonuçları" End With 'Normal Maaş Hesabı/Sonucu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Normal Maaş Hesabı/Sonucu" .OnAction = "nmaashes" .Style = msoButtonIconAndCaption .FaceId = 30 .State = msoButtonUp End With 'Kıstel Maaş Hesabı/Sonucu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Kıstel Maaş Hesabı/Sonucu" .OnAction = "kmaashes" .Style = msoButtonIconAndCaption .FaceId = 31 .State = msoButtonUp End With 'Fark Maaş Hesabı/Sonucu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Fark Maaş Hesabı/Sonucu" .OnAction = "fmaashes" .Style = msoButtonIconAndCaption .FaceId = 1950 .State = msoButtonUp End With 'Terfi Farkı Hesabı/Sonucu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Terfi Farkı Hesabı/Sonucu" .OnAction = "terfarkhes" .Style = msoButtonIconAndCaption .FaceId = 1953 .State = msoButtonUp End With 'Ekders Hesabı/Sonucu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Ekders Hesabı/Sonucu" .OnAction = "ekdershes" .Style = msoButtonIconAndCaption .FaceId = 1952 .State = msoButtonUp End With 'Emekli Kesintileri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Emekli Kesintileri" .OnAction = "emekes" .Style = msoButtonIconAndCaption .FaceId = 1951 .State = msoButtonUp End With 'Vergi Matrahları With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Vergi Matrahları" .OnAction = "vermat" .Style = msoButtonIconAndCaption .FaceId = 32 .State = msoButtonUp End With 'Özel Gider İndirimleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Özel Gider İndirimleri" .OnAction = "ozgidin" .Style = msoButtonIconAndCaption .FaceId = 33 .State = msoButtonUp End With 'Yurtiçi Geçici Görev Yolluğu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yurtiçi Geçici Görev Yolluğu" .OnAction = "yiçigecgoryol" .Style = msoButtonIconAndCaption .FaceId = 34 .State = msoButtonUp End With 'Yurtiçi Sürekli Görev Yolluğu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yurtiçi Sürekli Görev Yolluğu" .OnAction = "yiçisurgoryol" .Style = msoButtonIconAndCaption .FaceId = 35 .State = msoButtonUp End With 'Diğer Masraflar Nakit Fişi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Diğer Masraflar Nakit Fişi" .OnAction = "dmasnakfis" .Style = msoButtonIconAndCaption .FaceId = 36 .State = msoButtonUp End With 'Disketten Reçete Aktarımı With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Disketten Reçete Aktarımı" .OnAction = "disrecak" .Style = msoButtonIconAndCaption .FaceId = 37 .State = msoButtonUp End With 'Eczane Reçeteleri İşleme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Eczane Reçeteleri İşleme" .OnAction = "ecrecis" .Style = msoButtonIconAndCaption .FaceId = 38 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 4 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Genel Raporlar" End With 'Seçimli Listeler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Seçimli Listeler" .OnAction = "seclis" .Style = msoButtonIconAndCaption .FaceId = 39 .State = msoButtonUp End With 'Çarşaf Bordro(Hakedişler) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Çarşaf Bordro(Hakedişler)" .OnAction = "cbhaked" .Style = msoButtonIconAndCaption .FaceId = 40 .State = msoButtonUp End With 'Çarşaf Bordro(Kesintiler) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Çarşaf Bordro(Kesintiler)" .OnAction = "cbkes" .Style = msoButtonIconAndCaption .FaceId = 41 .State = msoButtonUp End With 'Çarşaf Maaş+Kıstel(Hakedişler) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Çarşaf Maaş+Kıstel(Hakedişler)" .OnAction = "cmkhaked" .Style = msoButtonIconAndCaption .FaceId = 42 .State = msoButtonUp End With 'Çarşaf Maaş+Kıstel(Kesintiler) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Çarşaf Maaş+Kıstel(Kesintiler)" .OnAction = "cmkkes" .Style = msoButtonIconAndCaption .FaceId = 43 .State = msoButtonUp End With 'Kıstel(Hakedişler) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Kıstel(Hakedişler)" .OnAction = "khaked" .Style = msoButtonIconAndCaption .FaceId = 44 .State = msoButtonUp End With 'Kıstel(Kesintiler) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Kıstel(Kesintiler)" .OnAction = "kkes" .Style = msoButtonIconAndCaption .FaceId = 45 .State = msoButtonUp End With 'Maaş+Terfi Hakedişler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maaş+Terfi Hakedişler" .OnAction = "mthaked" .Style = msoButtonIconAndCaption .FaceId = 46 .State = msoButtonUp End With 'Maaş+Terfi Kesintiler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maaş+Terfi Kesintiler" .OnAction = "mtkes" .Style = msoButtonIconAndCaption .FaceId = 47 .State = msoButtonUp End With 'Terfi Hakedişler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Terfi Hakedişler" .OnAction = "thaked" .Style = msoButtonIconAndCaption .FaceId = 48 .State = msoButtonUp End With 'Terfi Kesintiler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Terfi Kesintiler" .OnAction = "tkes" .Style = msoButtonIconAndCaption .FaceId = 49 .State = msoButtonUp End With 'Fark Hakedişler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Fark Hakedişler" .OnAction = "fhaked" .Style = msoButtonIconAndCaption .FaceId = 50 .State = msoButtonUp End With 'Fark Kesintiler With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Fark Kesintiler" .OnAction = "fkes" .Style = msoButtonIconAndCaption .FaceId = 51 .State = msoButtonUp End With 'Tek Sayfa Maaş Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tek Sayfa Maaş Bordrosu" .OnAction = "tsmbord" .Style = msoButtonIconAndCaption .FaceId = 1839 .State = msoButtonUp End With 'Tek Sayfa Maaş+Kıstel Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tek Sayfa Maaş+Kıstel Bordrosu" .OnAction = "tsmkbord" .Style = msoButtonIconAndCaption .FaceId = 53 .State = msoButtonUp End With 'Tek Sayfa Kıstel Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tek Sayfa Kıstel Bordrosu" .OnAction = "tskbord" .Style = msoButtonIconAndCaption .FaceId = 54 .State = msoButtonUp End With 'Tek Sayfa Maaş+Terfi Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tek Sayfa Maaş+Terfi Bordrosu" .OnAction = "tsmtbord" .Style = msoButtonIconAndCaption .FaceId = 55 .State = msoButtonUp End With 'Tek Sayfa Terfi Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tek Sayfa Terfi Bordrosu" .OnAction = "tstbord" .Style = msoButtonIconAndCaption .FaceId = 56 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 5 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Diğer Raporlar" End With 'Genel Nakit Fişi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Genel Nakit Fişi" .OnAction = "gennakfis" .Style = msoButtonIconAndCaption .FaceId = 57 .State = msoButtonUp End With 'Personel Bildirim With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Personel Bildirim" .OnAction = "perbild" .Style = msoButtonIconAndCaption .FaceId = 58 .State = msoButtonUp End With 'Özel Gider İndirimi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Özel Gider İndirimi" .OnAction = "ozgidind" .Style = msoButtonIconAndCaption .FaceId = 59 .State = msoButtonUp End With 'Rapor Kesinti Listesi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Rapor Kesinti Listesi" .OnAction = "rapkeslis" .Style = msoButtonIconAndCaption .FaceId = 60 .State = msoButtonUp End With 'Memur Nakil Bildirimi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Nakil Bildirimi" .OnAction = "mnakbil" .Style = msoButtonIconAndCaption .FaceId = 61 .State = msoButtonUp End With 'Hasta Sevk Kağıdı With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Hasta Sevk Kağıdı" .OnAction = "hsevk" .Style = msoButtonIconAndCaption .FaceId = 62 .State = msoButtonUp End With 'Maaş Defteri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maaş Defteri" .OnAction = "mdeft" .Style = msoButtonIconAndCaption .FaceId = 63 .State = msoButtonUp End With 'Yıllık Emeklilik Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yıllık Emeklilik Bordrosu" .OnAction = "yemekbord" .Style = msoButtonIconAndCaption .FaceId = 64 .State = msoButtonUp End With 'Eczane Reçete Listesi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Eczane Reçete Listesi" .OnAction = "eczreçl" .Style = msoButtonIconAndCaption .FaceId = 65 .State = msoButtonUp End With 'Maliye Disketi Oluşturma With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maliye Disketi Oluşturma" .OnAction = "mdisko" .Style = msoButtonIconAndCaption .FaceId = 66 .State = msoButtonUp End With 'Memur Maaş Bilgi Listesi(Form1) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Maaş Bilgi Listesi(Form1)" .OnAction = "mmblform1" .Style = msoButtonIconAndCaption .FaceId = 67 .State = msoButtonUp End With 'Memur Maaş Bilgi Listesi(Form2) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Maaş Bilgi Listesi(Form2)" .OnAction = "mmblform2" .Style = msoButtonIconAndCaption .FaceId = 68 .State = msoButtonUp End With 'Memur Maaş Bilgi Listesi(Form3) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Maaş Bilgi Listesi(Form3)" .OnAction = "mmblform3" .Style = msoButtonIconAndCaption .FaceId = 69 .State = msoButtonUp End With 'Kademe Terfisi Gelenler Listesi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Kademe Terfisi Gelenler Listesi" .OnAction = "kadtergel" .Style = msoButtonIconAndCaption .FaceId = 106 .State = msoButtonUp End With '2003 ve Öncesi Nakit Fişi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "2003 ve Öncesi Nakit Fişi" .OnAction = "2003öncnf" .Style = msoButtonIconAndCaption .FaceId = 107 .State = msoButtonUp End With 'Çok Amaçlı Raporlama With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Çok Amaçlı Raporlama" .OnAction = "carap" .Style = msoButtonIconAndCaption .FaceId = 108 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 6 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "SSK Raporları" End With 'SSK İşe İlk Giriş Bildirgesi(Normal) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "SSK İşe İlk Giriş Bildirgesi(Normal)" .OnAction = "iseilkgirn" .Style = msoButtonIconAndCaption .FaceId = 109 .State = msoButtonUp End With 'SSK İşe İlk Giriş Bildirgesi(Emekli) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "SSK İşe İlk Giriş Bildirgesi(Emekli)" .OnAction = "iseilkgire" .Style = msoButtonIconAndCaption .FaceId = 110 .State = msoButtonUp End With 'SSK Aylık Bildirge(Normal) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "SSK Aylık Bildirge(Normal)" .OnAction = "aybiln" .Style = msoButtonIconAndCaption .FaceId = 111 .State = msoButtonUp End With 'SSK Aylık Bildirge(Emekli) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "SSK Aylık Bildirge(Emekli)" .OnAction = "aybile" .Style = msoButtonIconAndCaption .FaceId = 112 .State = msoButtonUp End With 'SSK 4 Aylık Bordro With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "SSK 4 Aylık Bordro" .OnAction = "4aybord" .Style = msoButtonIconAndCaption .FaceId = 113 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 7 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Özel Servis İşlemleri" End With 'Memur Kayıt İptali With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Kayıt İptali" .OnAction = "memkayip" .Style = msoButtonIconAndCaption .FaceId = 201 .State = msoButtonUp End With 'Memur Sıra No Düzenleme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Sıra No Düzenleme" .OnAction = "memsnduz" .Style = msoButtonIconAndCaption .FaceId = 202 .State = msoButtonUp End With 'Maaş Hesapları İptal Etme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maaş Hesapları İptal Etme" .OnAction = "mhesip" .Style = msoButtonIconAndCaption .FaceId = 203 .State = msoButtonUp End With 'Ay Kapama Açma With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Ay Kapama Açma" .OnAction = "aykapac" .Style = msoButtonIconAndCaption .FaceId = 204 .State = msoButtonUp End With 'Yeni Aya Aktarma İşlemleri With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yeni Aya Aktarma İşlemleri" .OnAction = "yaaktris" .Style = msoButtonIconAndCaption .FaceId = 205 .State = msoButtonUp End With 'Yıl Sonu İşlemi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yıl Sonu İşlemi" .OnAction = "yılsonis" .Style = msoButtonIconAndCaption .FaceId = 206 .State = msoButtonUp End With 'Öğr.Dev-Dev.Ekders Aktar With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Öğr.Dev-Dev.Ekders Aktar" .OnAction = "ögrdevekakt" .Style = msoButtonIconAndCaption .FaceId = 207 .State = msoButtonUp End With 'El İle Emekli Kesintisi İşlemi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "El İle Emekli Kesintisi İşlemi" .OnAction = "eemkkesis" .Style = msoButtonIconAndCaption .FaceId = 208 .State = msoButtonUp End With 'Tasarruf Teşvik Nema Ödeme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Tasarruf Teşvik Nema Ödeme" .OnAction = "ttnemaod" .Style = msoButtonIconAndCaption .FaceId = 209 .State = msoButtonUp End With 'Fiili/İtibari Hizmet Zammı With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Fiili/İtibari Hizmet Zammı" .OnAction = "fiithizzam" .Style = msoButtonIconAndCaption .FaceId = 210 .State = msoButtonUp End With 'Toplu Diğer Kesinti İşleme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Toplu Diğer Kesinti İşleme" .OnAction = "tdkesis" .Style = msoButtonIconAndCaption .FaceId = 211 .State = msoButtonUp End With 'Toplu Özel Kesinti İşleme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Toplu Özel Kesinti İşleme" .OnAction = "tökesis" .Style = msoButtonIconAndCaption .FaceId = 212 .State = msoButtonUp End With 'Maaş Kontrol(Önceki Ayla) With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Maaş Kontrol(Önceki Ayla)" .OnAction = "makont" .Style = msoButtonIconAndCaption .FaceId = 213 .State = msoButtonUp End With 'Toplu Bilgi İşleme With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Toplu Bilgi İşleme" .OnAction = "tbilis" .Style = msoButtonIconAndCaption .FaceId = 214 .State = msoButtonUp End With 'Eğitime Hazırlık Bordrosu With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Eğitime Hazırlık Bordrosu" .OnAction = "ehazbord" .Style = msoButtonIconAndCaption .FaceId = 215 .State = msoButtonUp End With 'Memur Hizmet Belgesi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Hizmet Belgesi" .OnAction = "memhizbel" .Style = msoButtonIconAndCaption .FaceId = 216 .State = msoButtonUp End With 'Yazı Yazma With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yazı Yazma" .OnAction = "yyazma" .Style = msoButtonIconAndCaption .FaceId = 217 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 8 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Teknik Servis İşlemleri" End With 'Rapor Dizaynı Oluşturma With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Rapor Dizaynı Oluşturma" .OnAction = "rapdiz" .Style = msoButtonIconAndCaption .FaceId = 114 .State = msoButtonUp End With 'Memur Sıra No Taraması With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Memur Sıra No Taraması" .OnAction = "msntar" .Style = msoButtonIconAndCaption .FaceId = 115 .State = msoButtonUp End With 'Dosyaların Teknik Bakımı With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Dosyaların Teknik Bakımı" .OnAction = "tekbak" .Style = msoButtonIconAndCaption .FaceId = 116 .State = msoButtonUp End With '.................................................................................................... 'Alt Menü 9 Set AnaAltMenü = AnaMenü.Controls.Add(msoControlPopup, 1, , , True) With AnaAltMenü .Caption = "Yedekleme İşlemleri" End With 'Yedek Alma İşlemi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yedek Alma İşlemi" .OnAction = "yedal" .Style = msoButtonIconAndCaption .FaceId = 117 .State = msoButtonUp End With 'Yedek Geri Dönme İşlemi With AnaAltMenü.Controls.Add(msoControlButton, 1, , , True) .Caption = "Yedek Geri Dönme İşlemi" .OnAction = "yedgerd" .Style = msoButtonIconAndCaption .FaceId = 118 .State = msoButtonUp End With On Error Resume Next End Sub Sub auto_close() MenuBars(xlWorksheet).Reset End Sub

ID : 1514
ISLEM : menü ekleme
MAKRO KODU : Sub AjouteMenus() MenuBars(xlWorksheet).Menus.Add Caption:="&MonMenu", before:=9 '(before:=9)modifié cette valeur pour placer le menu où vous voulez MenuBars(xlWorksheet).Menus("&MonMenu").MenuItems.Add _ Caption:="&SousMenu1", before:=1, OnAction:="Nom de la macro 1" 'Exécute la macro 1 MenuBars(xlWorksheet).Menus("&MonMenu").MenuItems.Add _ Caption:="&SousMenu2", before:=1, OnAction:="Nom de la macro 2" 'Exécute la macro 2 End Sub Sub SupprimeMenus() For Each MenuName In MenuBars(xlWorksheet).Menus If MenuName.Caption = "&MonMenu" Then MenuName.Delete End If Next End Sub