Opacity of Userform VBa

This requires windows 2000 or higher. Code in a userform module:

CODE

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
    (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&

Public hWnd As Long

Private Sub UserForm_Initialize()
Dim bytOpacity As Byte
bytOpacity = 192 ' variable keeping opacity setting  
hWnd = FindWindow("ThunderDFrame", Me.Caption)
Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(Me.hWnd, 0, bytOpacity, LWA_ALPHA)
End Sub

Remove Userform Titlebar

*** Place this code In a User Form *** Option Explicit Private Sub UserForm_Initialize() Call RemoveCaption(Me) End Sub *** Place this code In a Module *** Option Explicit Private Declare Function FindWindow Lib "User32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "User32" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "User32" _ Alias "SetWindowLongA" (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "User32" ( _ ByVal hwnd As Long) As Long Sub RemoveCaption(objForm As Object) Dim lStyle As Long Dim hMenu As Long Dim mhWndForm As Long If Val(Application.Version) < 9 Then mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97 Else mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+ End If lStyle = GetWindowLong(mhWndForm, -16) lStyle = lStyle And Not &HC00000 SetWindowLong mhWndForm, -16, lStyle DrawMenuBar mhWndForm End Sub Sub ShowForm() UserForm1.Show False End Sub

How to use:	Open Excel. Alt + F11 to open the VBE. Insert UserForm. Paste the code from above that is designated for the User Form in the User Form code window. Insert Module. Paste the code from above that is designated for the Module in the Module code window. Close the VBE (Alt + Q or press the X in the top right corner).
Test the code:	Tools | Macro | Macros... Select ShowForm and press Run.

XML Code for Xml Menu Hide - UI14

<!-- This is example :  Dictator(2) With_Custom_Tab.xlsm  -->

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">

  <!-- Set startFromScratch to true to hide the Ribbon and QAT-->
  <ribbon startFromScratch="true">

<!-- startFromScratch="true" hides all of the Ribbon tabs and it hide the QAT.   -->
<!-- It not hides the Contextual tabs on the ribbon, for example the             -->
<!-- Format tab that you see when you select a picture on your worksheet.        -->
<!-- So if you want to hide them you must use the RibbonX below:                 -->

<contextualTabs>
<tabSet idMso="TabSetSmartArtTools" visible="false" />
<tabSet idMso="TabSetChartTools" visible="false" />
<tabSet idMso="TabSetDrawingTools" visible="false" />
<tabSet idMso="TabSetPictureTools" visible="false" />
<tabSet idMso="TabSetPivotTableTools" visible="false" />
<tabSet idMso="TabSetHeaderAndFooterTools" visible="false" />
<tabSet idMso="TabSetTableToolsExcel" visible="false" />
<tabSet idMso="TabSetPivotChartTools" visible="false" />
<tabSet idMso="TabSetInkTools" visible="false" />
<tabSet idMso="TabSetSparkline" visible="false" />
<tabSet idMso="TabSetTimeSlicerTools" visible="false" />
<tabSet idMso="TabSetSlicerTools" visible="false" />
<tabSet idMso="TabSetEquationTools" visible="false" />
</contextualTabs>

<!-- Add Custom tab to the Ribbon with your own buttons-->
<!-- The example add three groups to the new tab named 'My Tab' -->
<!-- On the last tab there is a menu with five options-->

    <tabs>
      <tab id="MyCustomTab" label="My Tab" >



        <group id="customGroup2" label="Reminders">
          <button id="customButton7" label="Send emails" size="large" onAction="Macro7" imageMso="ReviewPreviousComment" />
        </group>

      </tab>
    </tabs>


  </ribbon>

<!--hide all buttons and tabs in Backstage (File)-->
    <backstage>
        <button idMso="FileSave" visible="false"/>
        <button idMso="FileSaveAs" visible="false"/>
        <button idMso="FileOpen" visible="false"/>
        <button idMso="FileClose" visible="false"/>
        <button idMso="ApplicationOptionsDialog" visible="false"/>
        <button idMso="FileExit" visible="false"/>
        <tab idMso="TabInfo" visible="false"/>
        <tab idMso="TabRecent" visible="false"/>
        <tab idMso="TabNew" visible="false"/>
        <tab idMso="TabPrint" visible="false"/>
        <tab idMso="TabShare" visible="false"/>
        <tab idMso="TabHelp" visible="false"/>
        <tab idMso="TabPublish" visible="false"/>
        <tab idMso="TabSave" visible="false"/>
        <tab idMso="TabOfficeStart" visible="false"/>
    </backstage>
</customUI>

XML Code for Xml Menu Hide - UI

<!-- This is example : Dictator(2) With_Custom_Tab.xlsm  -->

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">


<!-- **************************************************************************-->
<!-- ****Disable 'Exit Excel' and 'Excel Options' on the Office Button menu****-->
<!-- **************************************************************************-->

<commands>
  <command idMso="ApplicationOptionsDialog" enabled="false"/>
  <command idMso="FileExit" enabled="false"/>
</commands>


<!-- *******************************************************************-->
<!-- *****Set startFromScratch to true to hide the Ribbon and QAT*******-->
<!-- ********Hide New, Open and Save on the Office Button menu**********-->
<!-- **************Hide Contextual tabs on the Ribbon*******************-->
<!-- *******************************************************************-->


  <!-- Set startFromScratch to true to hide the Ribbon and QAT-->
  <ribbon startFromScratch="true">

<!-- startFromScratch="true" hides all of the Ribbon tabs and it hide the QAT.   -->
<!-- It also hides most of the commands on the Office Button menu, but for       -->
<!-- some reason, it does not hide the 'New', 'Open' and 'Save' commands.        -->
<!-- Also it not hides the Contextual tabs on the ribbon, for example the        -->
<!-- Format tab that you see when you select a picture on your worksheet.        -->
<!-- So if you want to hide them you must use the RibbonX below:                 -->

<officeMenu>
<button idMso="FileNew" visible="false"/>
<button idMso="FileOpen" visible="false"/>
<button idMso="FileSave" visible="false" />
</officeMenu>

<contextualTabs>
<tabSet idMso="TabSetSmartArtTools" visible="false" />
<tabSet idMso="TabSetChartTools" visible="false" />
<tabSet idMso="TabSetDrawingTools" visible="false" />
<tabSet idMso="TabSetPictureTools" visible="false" />
<tabSet idMso="TabSetPivotTableTools" visible="false" />
<tabSet idMso="TabSetHeaderAndFooterTools" visible="false" />
<tabSet idMso="TabSetTableToolsExcel" visible="false" />
<tabSet idMso="TabSetPivotChartTools" visible="false" />
<tabSet idMso="TabSetInkTools" visible="false" />
</contextualTabs>


<!-- Add Custom tab to the Ribbon with your own buttons-->
<!-- The example add three groups to the new tab named 'My Tab' -->
<!-- On the last tab there is a menu with five options-->

    <tabs>
      <tab id="MyCustomTab" label="My Tab" >

       <group id="customGroup2" label="Reminders">
          <button id="customButton7" label="Send Emails" size="large" onAction="Macro7" imageMso="ReviewPreviousComment" />
        </group>

     
      </tab>
    </tabs>

  </ribbon>

</customUI>

Vbs to add attachment to outlook email (Outbox) Passing Key Strokes

' Outlook Mail Merge Attachment
'
' This script adds an attachment to all the emails that are currently
' in the Microsoft Office Outlook outbox. The script is tested with
' Microsoft Outlook 2003, 2007, 2010 and 2013.
'
' Usage:
' 1.  Create your mail merge and be sure the messages are kept in the
'     outbox (Work Offline).
' 2.  Execute (Double-Click) 'Outlook Mail Merge Attachment.vbs',
' 2a. select the attachment,
' 2b. the scripts now adds the selected file to all the emails in
'     the outbox.
' 3.  Send the emails by working Online.
'
' The emails are send by passing keystrokes. Please do not touch the keyboard or mouse while in process.
'
' For more information, visit http://omma.sourceforge.net or contact
' westerveld@users.sourceforge.net.
'
' Version 1.1.9 Beta, 26 October 2013
'
' Copyright (C) 2006-2013 Wouter Westerveld
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program.  If not, see <http://www.gnu.org/licenses/>.
'

SubOutlookMailMergeAttachment

Sub SubOutlookMailMergeAttachment
' Script version
strProgamName = "Outlook Mail Merge Attachment (v1.1.9 Beta)"
strProgamVersion = "Outlook Mail Merge Attachment (v1.1.9 Beta)"

' Set manual line-breaks in message box texts for windoes versions < 6.
strBoxCr = vbCrLf
On Error Resume Next
Set SystemSet = GetObject("winmgmts:").InstancesOf ("Win32_OperatingSystem")
For each System in SystemSet
If System.Version >= 6 Then
strBoxCr = ""
End If
sWindowsVersion = System.Caption
Next
On Error Goto 0

' Welcome dialog
strDialog = "This script adds an attachment to all the emails that are currently in the Microsoft Office Outlook outbox. " & strBoxCr & _
   "The script is tested with Microsoft Outlook 2003, 2007, 2010 and 2013." & vbCrLf & _
"" & vbCrLf & _
"Usage:" & vbCrLf & _
"1.  Create your mail merge and be sure the messages are kept in the outbox (Work Offline)." & vbCrLf & _
"2.  Execute (Double-Click) 'Outlook Mail Merge Attachment.vbs',"  & vbCrLf & _
"2a.  select the attachment(s)," & vbCrLf & _
"2b.  the scripts now adds the selected file to all the emails in the outbox." & vbCrLf & _
"3.   Send the emails by working Online." & vbCrLf & _
"" & vbCrLf & _
"The emails are send by passing keystrokes. Please do not touch the keyboard or mouse while in " & strBoxCr & _
"process." & vbCrLf & _
"" & vbCrLf & _
"Do you want to continiue?" & vbCrLf & _
"" & vbCrLf & _
"" & vbCrLf & _
    "http://omma.sourceforge.net" & vbCrLf & _
    "westerveld@users.sourceforge.net" & vbCrLf & _
"" & vbCrLf & _
"Copyright (C) 2006-2013 Wouter Westerveld" & vbCrLf & _
"This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without "  & strBoxCr & _
"even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the "  & strBoxCr & _
"GNU General Public License for more details."

'''''''''''''''''''''''''''''''''''''''''''''''
' Initialize, load objects, check
'''''''''''''''''''''''''''''''''''''''''''''''

    If MsgBox(strDialog, vbOKCancel + vbInformation, strProgamName) = vbCancel Then
        ' fout
   Exit Sub                
    End If  
     
    ' Outlook and Word Constants
    intFolderOutbox = 4
    msoFileDialogOpen = 1
 
 
    ' Load requied objects
    Set WshShell = WScript.CreateObject("WScript.Shell") ' Windows Shell
    Set ObjWord = CreateObject("Word.Application")      ' File Open dialog  
    Set ObjOlApp = CreateObject("Outlook.Application")      ' Outlook
    Set ns = ObjOlApp.GetNamespace("MAPI")                  ' Outlook
    Set box = ns.GetDefaultFolder(intFolderOutbox)          ' Outlook                    
       
    ' Check if we can detect problems in the outlook configuration
    sProblems = ""  
    sBuild = Left(ObjOlApp.Version, InStr(1, ObjOlApp.Version, ".") + 1)
 
    ' check spelling check just before sending
    On Error Resume Next
    r = WshShell.RegRead("HKCU\Software\Microsoft\Office\" & sBuild & "\Outlook\Options\Spelling\Check")  
    If Not(Err) And (r = 1) Then
    sProblems = sProblems & _    
    "Your Outlook spell check is configured such that it gives a pop-up box when sending emails. Please disable " & strBoxCr & _
    "the 'Always check spelling before sending' option in your Outlook. (ErrorCode = 101)" & vbCrLf &vbCrLf
    End If
    On Error Goto 0
 
' For outlook 2000, 2002, 2003
If sBuild = "9.0" Or sBuild = "10.0" Or sBuild = "11.0" Then

   ' Check for word as email editor.
   On Error Resume Next
intEditorPrefs = WshShell.RegRead("HKCU\Software\Microsoft\Office\" & sBuild & "\Outlook\Options\Mail\EditorPreference")
If Not(Err) Then
If intEditorPrefs = 131073 Or intEditorPrefs = 196609 Or intEditorPrefs = 65537 Then
' HTML = 131072, HTML & Word To Edit = 131073, Rich Text = 196610, Rich Text & Word To Edit = 196609, Plain Text = 65536, Plain Text & Word To Edit = 65537
sProblems = sProblems & _
"Your Outlook is configured to use Word as email editor. Please change this to the internal outlook editor in " & strBoxCr & _
"your outlook settings. (ErrorCode = 102)" & vbCrLf &vbCrLf
End If
End If
On Error Goto 0
End If

If sProblems <> "" Then  
sProblems = "The OMMA script detected settings in your Outlook settings that need to be changed for the software to work." & vbCrLf & vbCrLf & sProblems
MsgBox sProblems, vbExclamation, strProgamName
'fout
Exit Sub
End If

     
    ' Check if there are messages
    If box.Items.Count = 0 Then
        MsgBox "There are no messages in the Outbox.", vbExclamation, strProgamName        
        ' fout
       Exit Sub
    End If
 
    ' Give a warning if there already is an attachment
    If box.Items(1).Attachments.Count > 0 Then
        If MsgBox("The first email in your outbox has already " & box.Items(1).Attachments.Count & " attachment(s). Do you want to continue?", vbOKCancel + vbQuestion, strProgamName) = vbCancel Then
            ' fout
   Exit Sub          
        End If
    End If
     
 
     
    '''''''''''''''''''''''''''''''''''''''''''''''
    ' Ask user for Filenames, add atachment, and
    ' Add attachment and save email
    '''''''''''''''''''''''''''''''''''''''''''''''  
     
     
    ' Ask user to open a file
    ' Select the attachment filename
 
ObjWord.ChangeFileOpenDirectory(CreateObject("Wscript.Shell").SpecialFolders("Desktop"))
ObjWord.FileDialog(msoFileDialogOpen).Title = "Attach file(s)..."
ObjWord.FileDialog(msoFileDialogOpen).AllowMultiSelect = True


okEscape = False
If ObjWord.FileDialog(1).Show = -1 Then
If ObjWord.FileDialog(1).SelectedItems.Count > 0 Then
okEscape = True
End If
End If

If Not okEscape Then
ObjWord.Quit
MsgBox "Cancel was pressed, no attachments where added.", vbExclamation, strProgamName
Exit Sub  
End If

    WScript.Sleep(800)            
     
    ' Add the attachment to each email
    For Each Item In box.Items      
    For Each objFile in ObjWord.FileDialog(1).SelectedItems
        Item.Attachments.Add(objFile)
        Next          
        Item.Save
    Next

ObjWord.Quit
 
  '''''''''''''''''''''''''''''''''''''''''''''''
  ' Send the emails using keystrokes
  '''''''''''''''''''''''''''''''''''''''''''''''
 
    For i = 1 to box.Items.Count
     
        ' Wait 5 extra seconds after 50 emails
        If (i Mod 50) = 0 Then
    WScript.Sleep(5000)    
        End If
     
        ' Open email
        Set objItem = box.Items(i)
Set objInspector = objItem.GetInspector
objInspector.Activate
WshShell.AppActivate(objInspector.Caption)
objInspector.Activate

' wait upto 10 seconds until the window has focus
okEscape = False
For j = 1 To 100
WScript.Sleep(100)
If (objInspector Is ObjOlApp.ActiveWindow) Then
okEscape = True
Exit For
End If
Next
If Not(okEscape) Then        
       MsgBox "Internal error while opening email in outbox. Please read the how-to and the troubleshooting sections in the " & strBoxCr & "documentation. (ErrorCode = 103)", vbError, strProgamName
      ' fout
      Exit Sub
End If

' send te email by typing ALT+S
WshShell.SendKeys("%S")

' wait upto 10 seconds for the sending to complete
okEscape = False
For j = 1 To 100
WScript.Sleep(100)
boolSent = False
On Error Resume Next
boolSent = objItem.Sent
If Err Then
boolSent = True
End If
On Error Goto 0
If boolSent Then
okEscape = True
Exit For
End If
Next
If Not(okEscape) Then
' Error    
       MsgBox "Internal error while sending email. Perhaps the email window was not activated. Please read the how-to and " & strBoxCr & "the troubleshooting sections in the documentation. (ErrorCode = 104)", vbExclamation, strProgamName
      ' fout
      Exit Sub
End If



    Next

    ' Finished  
    strDialog = "Successfully added the attachment to " & box.Items.Count & " emails." & vbCrLf & vbCrLf & _    
    "OMMA is free software, please let the author know whether OMMA worked properly. " &strBoxCr & _
    "Did you already fill the feedback form?" & vbCrLf & vbCrLf & _
    "Answer 'No' will open the feedback form in your browser."  & vbCrLf & _
    "Answer 'Yes' just exit the script."
   
    If MsgBox(strDialog, vbYesNo + vbInformation, strProgamName) = vbNo Then
WshShell.Run "http://omma.sourceforge.net/feedback.php?worksok=yes&verOmma=" & escape(strProgamVersion) & "&verWindows=" & escape(sWindowsVersion) & "&verOutlook=" & escape(sBuild)
    End If      
 
End Sub

Vba to create installer like code

Sub CreateShortCut()
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String
Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")
Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
ActiveWorkbook.Name & ".lnk")
With oShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Set oWSH = Nothing
End Sub