Oifs 2007 ve üzeri versiyonlarda kullanılan ribbon menüler kullanıcılar tarafından çok beğenilmişti. Ancak bu menü yapısıma yeni eklemeler ya da çıkarmalar pek mümkün değildi. Aslında bu menü elemanları xml formatında text metinlerden ibarettir. Bu uygulamada açılan yeni dosyaya menü ekleme ve çıkarma işlemini gerçekleştireceğiz.

Aşağıdaki kodları module sayfasına yazınız.

Sub auto_open()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, 
user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"
d1 = "A11C-Web"
d2 = "A11C-Mobil"
d3 = "M11G-Web"
d4 = "AL-Web"
ribbonXML = "<mso:customUI      xmlns:mso=
'http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
ribbonXML = ribbonXML + "  <mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:qat/>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "      <mso:tab id='reportTab' 
label='Uygulamalar' insertBeforeQ='mso:TabFormat'>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup' 
label='Temrinler' autoScale='true'>" & vbNewLine

ribbonXML = ribbonXML + "          <mso:button id='customButton1' 
label='" & d1 & "' size='large' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='DirectRepliesTo'      
onAction='Macro1'/>" & vbNewLine

ribbonXML = ribbonXML + "          <mso:button id='customButton2' 
label='" & d2 & "' size='large' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AccountMenu'      
onAction='Macro2'/>" & vbNewLine

ribbonXML = ribbonXML + "          <mso:button id='customButton3' 
label='" & d3 & "' size='large' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AccountMenu'     
onAction='Macro3'/>" & vbNewLine

ribbonXML = ribbonXML + "          <mso:button id='customButton4' 
label='" & d4 & "' size='large' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='HappyFace'      
onAction='Macro4'/>" & vbNewLine

ribbonXML = ribbonXML + "        </mso:group>" & vbNewLine
ribbonXML = ribbonXML + "      </mso:tab>" & vbNewLine
ribbonXML = ribbonXML + "    </mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "  </mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "</mso:customUI>"

ribbonXML = Replace(ribbonXML, """", "")

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

Sub Macro1()
    MsgBox "A11-CW Sınıfı Uygulama Kontrol Penceresi"
End Sub

Sub Macro2()
    MsgBox "A11-CW Sınıfı Uygulama"
End Sub

Sub Macro3()
    MsgBox "A11-CW Sınıfı Uygulama"
End Sub

Sub Macro4()
    MsgBox "A11-CW Sınıfı fffffffffffffffffff"
End Sub

Aşağıdaki kodu ise çalışma kitabına yazınız.

Private Sub Workbook_Deactivate()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI           
xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon></mso:ribbon></mso:customUI>"

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub