Attribute VB_Name = "ContMenuGrafico"
Option Explicit
Dim ContClass As New ContClass1

Public Sub CONTABILIZALO_menuPersonalizado()
    Call CONTABILIZALO_insertarMenu
    Call showMessaje
End Sub

Private Sub CONTABILIZALO_insertarMenu()
    Application.ScreenUpdating = False
    
    Call instalarMenus
    
    Dim sh As Worksheet
    Dim oldActiveCell As String
    Dim oldActiveSheet As String
    
    oldActiveSheet = ActiveSheet.Name
    
    For Each sh In Sheets
        sh.Activate
        oldActiveCell = ActiveCell.Address
        Range("A5").Select

        Call borrarMenuDeFormas(sh)
        Call insertEyelash(sh)
        
        Range(oldActiveCell).Select
    Next sh
    
    Sheets(oldActiveSheet).Activate
    
    Application.ScreenUpdating = True
    
    'Call showMessaje
End Sub

Private Sub insertEyelash(ByVal sh As Worksheet)
    Dim i, leftDistance, widthShape, widthBar, topShape, heigthShape, leftDistanceBar, witdBar As Integer
    Dim lashText As String
   
    Range("a5").Select
    ActiveWindow.FreezePanes = True
    
    leftDistance = 50
    widthShape = 100
    heigthShape = 27
    topShape = 15
    'SHAPE PARAMETERS
    leftDistanceBar = leftDistance - 25
    witdBar = widthShape + 25
    
    
'    ActiveSheet.Shapes.AddShape(msoShapeRectangle, leftDistanceBar, topShape + 25, witdBar, heigthShape - 10).Select
'    Selection.ShapeRange.ZOrder msoSendToBack
    
    For i = 1 To Sheets.Count
        Call createSheetShape(sh, leftDistance, widthShape, Sheets(i)) 'ultimo parametro es el caption
        leftDistance = (leftDistance + 100) + 5
        witdBar = witdBar + widthShape
    Next i
    
    'barra inferior
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, leftDistanceBar, topShape + 27, witdBar, topShape).Select
    Selection.ShapeRange.ZOrder msoSendToBack
    Selection.ShapeRange.Line.visible = msoFalse
    Selection.Name = "Contabilizalo_menu_1"
    
    ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), _
    Address:="", SubAddress:="'" & sh.Name & "'!A10"
    
    With Selection.ShapeRange.Fill
        .visible = msoTrue
        .ForeColor.RGB = RGB(0, 222, 0)
        .Transparency = 0
        .Solid
    End With
    
End Sub

Private Sub createSheetShape(ByVal sh As Worksheet, ByVal leftDistance As Integer, ByVal widthShape As Integer, ShCicle As Worksheet)
    Dim heigthShape, topShape As Integer
                
    heigthShape = 27
    topShape = 15

    If sh.Name = ShCicle.Name Then
        heigthShape = 32
        topShape = 10
    End If
    
    sh.Shapes.AddShape(msoShapeRound2SameRectangle, leftDistance, topShape, widthShape, heigthShape).Select
    Selection.Name = "Contabilizalo_menu_1"
    
    If sh.Name = ShCicle.Name Then
        With Selection.ShapeRange.Fill
            .visible = msoTrue
            .ForeColor.RGB = RGB(0, 222, 0)
            .Transparency = 0
            .Solid
        End With
    Else
        With Selection.ShapeRange.Fill
            .visible = msoTrue
            .ForeColor.RGB = RGB(192, 0, 0)
            .Transparency = 0
            .Solid
        End With
    End If
       
    Dim columName As String
    columName = Mid(ActiveSheet.Cells(1, ShCicle.index * 2).Address, 2, InStr(2, ActiveSheet.Cells(1, ShCicle.index * 2).Address, "$") - 2)
    
    ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), _
    Address:="", SubAddress:="'" & ShCicle.Name & "'!" & columName & ShCicle.index * 2 'ActiveCell.Address  '"Hoja2!A10"
    
'    With Selection.ShapeRange.Fill
'        .Visible = msoTrue
'        .ForeColor.RGB = RGB(192, 0, 0)
'        .Transparency = 0
'        .Solid
'    End With
    
    Selection.ShapeRange.Line.visible = msoFalse
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ShCicle.Name
    
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, Len(ShCicle.Name)). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    
End Sub

Private Sub borrarMenuDeFormas(ByVal sh As Worksheet)
    
    'Dim oldActiveSh As String
    Dim fm As Shape
    
    For Each sh In Sheets
        'sh.Activate
        
        ActiveWindow.FreezePanes = False
        For Each fm In ActiveSheet.Shapes
            If fm.Name = "Contabilizalo_menu_1" Then
                fm.Delete
            End If
        Next fm
    Next sh
End Sub

Private Sub deleteShapes(sh As Worksheet)
    Dim fm As Shape
    sh.Activate
    ActiveWindow.FreezePanes = False
    For Each fm In ActiveSheet.Shapes
        If fm.Name = "Contabilizalo_menu_1" Then
            fm.Delete
        End If
    Next
End Sub

Private Sub deleteFromBtnMenuFormas() 'attach with meny btn BORRAR MENU FORMAS
    Application.ScreenUpdating = False
    Dim sh As Worksheet
    Dim oldSheet As String
    
    oldSheet = ActiveSheet.Name
    
    For Each sh In Sheets
        Call deleteShapes(sh)
    Next
    
    Sheets(oldSheet).Activate
    Application.ScreenUpdating = True
End Sub


Private Sub mostarMenuLateral()
    On Error GoTo mark
    Call instalarMenus
    'Call createForm
    Call insertList
    'Call showMessaje
    
    Exit Sub
mark:
    Dim messaje As String
    Dim goToPage As Byte
    
    messaje = "Error!" _
           & Chr(13) & Chr(10) & "¿Active la opción Sujerencias de directiva?" _
           & Chr(13) & Chr(10) & "Archivo > Centro de confianza > Configuración del centro de confianza > configuración de macros > Configuración de la macro del programador (Marquela)"

    goToPage = MsgBox(prompt:=messaje, Buttons:=vbOKOnly + vbExclamation + vbDefaultButton2, Title:="ConTabilizalo.com")
    
End Sub


Private Function createForm()

    Dim frmObj As Object
    Dim totElems As Integer, k As Integer
        
    totElems = ThisWorkbook.VBProject.VBComponents.Count
    Application.DisplayAlerts = False

    For k = 1 To totElems
        If ThisWorkbook.VBProject.VBComponents(k).Name = "FrmContab" Then
            'ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("frmContabilizalo")
            Exit Function
        End If
    Next k
    
    Set frmObj = ThisWorkbook.VBProject.VBComponents.Add(3)
    
'    If exitForm = 0 Then
'        Set frmObj = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
'    Else
'        Set frmObj = ThisWorkbook.VBProject.VBComponents.Item(exitForm)
'    End If
    'MsgBox ("inicio")
    Application.Wait (Now + TimeValue("0:00:05"))
    'MsgBox ("fin")
    With frmObj
'        .Properties("Caption") = "Páginas de este libro"
'        .Properties("Width") = 270
'        .Properties("Height") = 320
        .Properties("Name") = "FrmContab"
    End With
    
    Application.DisplayAlerts = True

End Function


Private Sub insertList()
    Dim widthForm As Integer, heightForm As Integer
    
    widthForm = 200
    heightForm = 350

    FrmContab.Caption = "Páginas en este libro"
    FrmContab.StartUpPosition = 0
    FrmContab.Top = Application.Top + 150
    FrmContab.Left = Application.Left + Application.Width - FrmContab.Width - 10
    FrmContab.Height = heightForm
    FrmContab.Width = widthForm
    FrmContab.Show (0)

    
    Dim framePg As MSForms.Frame

    Set framePg = FrmContab.Controls.Add("Forms.frame.1")
    
    With framePg
        .Width = widthForm - 20
        .Height = heightForm - 70
        .Caption = "Hojas:"
        .Left = 5
    End With
    

    Dim listMenu As MSForms.ListBox
    
    Set listMenu = framePg.Controls.Add("Forms.listBox.1")
    
    With listMenu
        .Top = framePg.Top + 5
        .Height = framePg.Height - 20
        .Left = 5
        .Width = framePg.Width - 12
        .MousePointer = fmMousePointerDefault
    End With
    
    Dim sh As Worksheet
    
    For Each sh In Sheets
        listMenu.AddItem sh.Name
    Next
    
    Set ContClass.listEvent = listMenu
    
    Dim lblCourse As MSForms.Label
    
    Set lblCourse = FrmContab.Controls.Add("Forms.label.1")
    
    With lblCourse
        .Caption = "¿Quieres aprender a hacer este tipo de formularios? HAS CLICK"
        .Top = framePg.Height + 10
        .Width = framePg.Width - 12
        .Left = 10
        .ForeColor = RGB(0, 2, 255)
        .MousePointer = fmMousePointerHelp
    End With
   
    Set ContClass.lblEvent = lblCourse
End Sub

Private Sub showFormFinal()
    Dim totSheets As Integer, i As Integer, counter As Integer, topPx As Integer, leftPx As Integer, btnWidth As Integer
    Dim j As Byte

    totSheets = Sheets.Count
    counter = 1
    topPx = 20
    btnWidth = 90
    leftPx = 10
    
    For i = 1 To Round(totSheets / 2, 0)
        For j = 1 To 2
            If counter > totSheets Then
                Exit For
            End If
            
            Call insertButton(FrmContab, Sheets(counter), topPx, leftPx)
            leftPx = leftPx + btnWidth + 10
            counter = counter + 1
        Next j
                
        topPx = 27 + topPx
        leftPx = 10
    Next i

    FrmContab.Caption = "Páginas en este libro"
    
    FrmContab.StartUpPosition = 0
    FrmContab.Top = Application.Top + 150
    FrmContab.Left = Application.Left + Application.Width - FrmContab.Width - 25
    FrmContab.Height = 350
    FrmContab.Width = 230
    FrmContab.Show (0)
End Sub

Private Sub closeLateralMenu()
    FrmContab.Hide
End Sub


Private Sub instalarMenus()
    
    Dim cmdBarMenu As CommandBar
    Dim cmdBarMenuPopup1 As CommandBarPopup
    Dim cmdBarMenuPopup2 As CommandBarPopup
    
    Dim cmdBarBtn1 As CommandBarButton
    Dim cmdBarBtn2 As CommandBarButton
        
    On Error Resume Next
    Application.CommandBars("ConTabilizalo").Delete
    
    Set cmdBarMenu = CommandBars.Add(Name:="ConTabilizalo", Position:=msoBarFloating)
    'GRAPHIC MENU
    Set cmdBarMenuPopup1 = cmdBarMenu.Controls.Add(msoControlPopup)
    cmdBarMenuPopup1.Caption = "Menú Gráfico"
        
    Set cmdBarBtn1 = cmdBarMenuPopup1.Controls.Add(msoControlButton)
    With cmdBarBtn1
        .Caption = "Añadir Menú"
        .Style = msoButtonIconAndCaption
        .OnAction = "ContMenuGrafico.CONTABILIZALO_insertarMenu"
        .FaceId = 12
    End With
    
    Set cmdBarBtn2 = cmdBarMenuPopup1.Controls.Add(msoControlButton)
    With cmdBarBtn2
        .Caption = "Borrar Menú"
        .Style = msoButtonIconAndCaption
        .OnAction = "ContMenuGrafico.deleteFromBtnMenuFormas"
        .FaceId = 6
    End With
    
    'LATERAL MENU
    Set cmdBarMenuPopup2 = cmdBarMenu.Controls.Add(msoControlPopup)
    cmdBarMenuPopup2.Caption = "Menú lateral"
        
    Set cmdBarBtn1 = cmdBarMenuPopup2.Controls.Add(msoControlButton)
    With cmdBarBtn1
        .Caption = "Añadir Menú"
        .Style = msoButtonIconAndCaption
        .OnAction = "ContMenuGrafico.mostarMenuLateral"
        .FaceId = 12
    End With
    
    Set cmdBarBtn2 = cmdBarMenuPopup2.Controls.Add(msoControlButton)
    With cmdBarBtn2
        .Caption = "Cerrar Menú"
        .Style = msoButtonIconAndCaption
        .OnAction = "ContMenuGrafico.closeLateralMenu"
        .FaceId = 6
    End With
    
    cmdBarMenu.visible = True
    
    'Call showMessaje
    
End Sub

Private Sub showMessaje()
    Dim messaje As String
    Dim goToPage As Byte
    
    messaje = "Excelente, Menú Instalado!" _
           & Chr(13) & Chr(10) & "¿Deseas aprender a crear macros interesantes como estos?" _
           & Chr(13) & Chr(10) & "ConTabilizalo.com"

    goToPage = MsgBox(prompt:=messaje, Buttons:=vbOKOnly + vbExclamation + vbDefaultButton2, Title:="ConTabilizalo.com")
    
    If goToPage = vbOK Then
        ThisWorkbook.FollowHyperlink ("https://contabilizalo.com/promo/curso-excel-macros-vba")
    End If
End Sub