• Home
 · 
• Custom Controls/Forms/Menus
 · 
• short cut for xl sheets.

short cut for xl sheets.

short cut for xl sheets.

Rate short cut for xl sheets.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    a = Range("sname").Value
    If Range(a).Value = Range("switch1").Value Then
    Range(a).Value = Range("switch2").Value
        Else
    Range(a).Value = Range("switch1").Value
    End If
    Application.Calculate
End Sub

Sub Prepare()
    Dim sheet As Worksheet
    i = 3
    Worksheets("Manager").Select
    Range("PrintQuery").Select
    For Each sheet In ActiveWorkbook.Worksheets
        Range("PrintQuery").Cells(i, 0).Value = sheet.Name
        If sheet.Visible Then
            Range("PrintQuery").Cells(i, 1).Value = 1
        Else
            Range("PrintQuery").Cells(i, 1).Value = 0
        End If
        i = i + 1
        Range("PrintQuery").Value = i - 3
    Next sheet
End Sub
    
Sub HideUnhide()
    For i = 3 To 2 + Range("PrintQuery").Value
    If Range("PrintQuery").Cells(i, 1) = 1 Then
        Worksheets(Range("PrintQuery").Cells(i, 0).Value).Visible = True
        Else
        Worksheets(Range("PrintQuery").Cells(i, 0).Value).Visible = False
        End If
    Next i
End Sub

Sub Choose()
    For i = 3 To 2 + Range("PrintQuery").Value
      If Range("PrintQuery").Cells(i, 2) = 1 Then
         Worksheets(Range("PrintQuery").Cells(i, 0).Value).Visible = True
         Worksheets(Range("PrintQuery").Cells(i, 0).Value).Select (False)
      End If
    Next i
End Sub

    
Sub PrintSheets()
    Application.Calculate
    For i = 3 To 2 + Range("PrintQuery").Value
      If Range("PrintQuery").Cells(i, 2) = 1 Then
        Worksheets(Range("PrintQuery").Cells(i, 0).Value).Visible = True
        Worksheets(Range("PrintQuery").Cells(i, 0).Value).Select
        
            Text = Range("A1").Value
            If InStr(Text, "_") <> 0 Then
                   j = 1
                   While j <> Len(Text)
                    k = InStr(j + 1, Text, "_")
  '                  MsgBox (Mid(Text, j + 1, k - j))
                    With ActiveSheet.PageSetup
                        .CenterHorizontally = True
                        .FitToPagesWide = 1
                        .FitToPagesTall = 1
                    End With
                    Range(Mid(Text, j + 1, k - j - 1)).PrintOut Copies:=1
                    j = k
                   Wend
            End If
           
      End If
      If Range("PrintQuery").Cells(i, 1) = 1 Then
        Worksheets(Range("PrintQuery").Cells(i, 0).Value).Visible = True
        Else
        Worksheets(Range("PrintQuery").Cells(i, 0).Value).Visible = False
        End If
    Next i
End Sub

Sub GotoHyp()
If ActiveSheet.Name = "Assumptions" Then
    Worksheets(Range("LASTWORK").Value).Select
        Else
    Range("LASTWORK").Value = ActiveSheet.Name
    Worksheets("Assumptions").Select
End If
End Sub

Function dec(tot, x) As Double
dec = (tot + 1) * x
End Function


Sub affiche()
    Range("ALLSHEETS").Value = 1
End Sub

Sub efface()
    Range("ALLSHEETS").Clear
    Range("ALLSHEETS").Cells(3, 1).Value = 1
    Range("ALLSHEETS").Cells(5, 1).Value = 1
End Sub
                    

Sub mille()
    For i = 1 To Selection.Rows.Count
        For j = 1 To Selection.Columns.Count
            Selection.Cells(i, j).Value = Selection.Cells(i, j).Value * 0.001
        Next j
    Next i
End Sub

Sub moins()
    For i = 1 To Selection.Rows.Count
        For j = 1 To Selection.Columns.Count
            Selection.Cells(i, j).Value = -Selection.Cells(i, j).Value
        Next j
    Next i
End Sub

Sub page()
    On Error GoTo suite
re: ActiveCell.Cells(-0, 1).Activate
    GoTo re
suite:    While (ActiveCell.Value = "" Or Mid(ActiveCell.Value, 1, 1) = "_")
    ActiveCell.Cells(1, 0).Activate
    Wend
    Range(ActiveCell.Value).Select
End Sub

Sub printselection()
    Selection.PrintOut
End Sub

Sub PrintselectionV()
    ActiveSheet.PageSetup.Orientation = xlPortrait
    Selection.PrintOut
    ActiveSheet.PageSetup.Orientation = xlLandscape
End Sub

Sub insertligne()
    Set Rightcell = ActiveCell
    Set Leftcell = ActiveCell
    While (Rightcell.Offset(0, 1).Interior.ColorIndex = xlNone)
        Set Rightcell = Rightcell.Offset(0, 1)
    Wend
    While (Leftcell.Offset(0, -1).Interior.ColorIndex = xlNone)
        Set Leftcell = Leftcell.Offset(0, -1)
    Wend
    Range(Leftcell.Address, Rightcell.Address).Insert Shift:=xlDown
End Sub

Sub retireligne()
    Set Rightcell = ActiveCell
    Set Leftcell = ActiveCell
    While (Rightcell.Offset(0, 1).Interior.ColorIndex = xlNone)
        Set Rightcell = Rightcell.Offset(0, 1)
    Wend
    While (Leftcell.Offset(0, -1).Interior.ColorIndex = xlNone)
        Set Leftcell = Leftcell.Offset(0, -1)
    Wend
    Range(Leftcell.Address, Rightcell.Address).Delete Shift:=xlUp
End Sub

Sub PrintLocal()
    Set Rightcell = ActiveCell
    Set Leftcell = ActiveCell
    While (Rightcell.Offset(0, 1).Interior.ColorIndex = xlNone)
        Set Rightcell = Rightcell.Offset(0, 1)
    Wend
    While (Rightcell.Offset(1, 0).Interior.ColorIndex = xlNone)
        Set Rightcell = Rightcell.Offset(1, 0)
    Wend
    While (Leftcell.Offset(0, -1).Interior.ColorIndex = xlNone)
        Set Leftcell = Leftcell.Offset(0, -1)
    Wend
    While (Leftcell.Offset(-1, 0).Interior.ColorIndex = xlNone)
        Set Leftcell = Leftcell.Offset(-1, 0)
    Wend
    Range(Leftcell.Address, Rightcell.Address).Select
    'Application.Run Macro:="NewPrintScalePro"
End Sub

Sub calc()
ActiveSheet.Calculate
End Sub



    
Sub copyacross()
    Range(ActiveCell.Address, ActiveCell.Cells(1, 2).Address).Select
Selection.Copy
    Range(ActiveCell.Address, ActiveCell.Cells(1, 24).Address).Select
ActiveSheet.Paste
End Sub