short cut for xl sheets.

by ankush mago (1 Submission)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 9^th September 2008
Date Added: Mon 8^th February 2021
Rating: (1 Votes)
Rate short cut for xl sheets.


    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
Download this snippet Add to My Saved Code
short cut for xl sheets. Comments

No comments have been posted about short cut for xl sheets.. Why not be the first to post a comment about short cut for xl sheets..
short cut for xl sheets.

short cut for xl sheets. Comments

Post your comment

Difficulty
