Hàm Range

Liên hệ QC

cbtm

Thành viên mới
Tham gia
16/1/07
Bài viết
35
Được thích
0
Nghề nghiệp
WWW.JABIL.COM
NHỜ CÁC PRO GIÚP
* MÌNH MUỐN KHI NHẬP DỬ̉ LIỆU TỪ A1 CHO ĐẾN A34 THÌ WORKBOOK SẺ SAVE LẠI VÀ MỚI MỘT WORKBOOK MỚI.
* phần thứ là khi mình enter password để xem gía trị từ ngày cho đến ngày kia thì khi click yes tryagain, như click no thì nó lại cho ra gía trị
CODE NÀY TRONG WORKBOOK

Mã:
Option Explicit
 Function InEx(Jolienailspa$) As Long
 Dim XLS As New Workbooks
 Dim wb As Workbook
 Dim Ws As Worksheet
 Set wb = XLS.Open(Jolienailspa)
 Set Ws = wb.Worksheets(1)
 Set Ws = Nothing
 Ws.PrintOut
 wb.Close
XLS.Close
 End Function
 Private Sub workbook_Open()
UserForm1.Show
   ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\JOLIE NAIL SPA\" & ".xls", _
            Password:="" 'jolie nail spa
    ActiveWorkbook(“USERFORM”).Range("A1:A33").Select
     Selection.Font.Bold = True
     Selection.Font.Italic = True
     Selection.Font.ColorIndex = 3
      With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
      End With
   Range("A34").Select
    Workbooks.Add
    Sheets("main").Select:              Range("A1").Value = "day"
    Range("B1").Value = "money":     Range("C1").Value = "tip"
    Range("D1").Value = "Share":     Range("E1").Value = "cash"
    Range("F1").Value = "check":     Range("G1").Value = "total"
        With ActiveWorkbook
              .Save
              .Close
        End With
End Sub

CODE NÀY NẰM TRONG USERFROM
PHP:
Option Explicit
Public H1
Public H2
Function Find_Range(Find_Item As Variant, Search_Range As Range, _
   Optional LookIn As Variant, Optional LookAt As Variant, _
   Optional MatchCase As Boolean) As Range
Dim Rng As Range:             Dim firstAddress As String

 If IsMissing(LookIn) Then LookIn = xlValues
If IsMissing(LookAt) Then LookAt = xlWhole
 If IsMissing(MatchCase) Then MatchCase = True
   With Search_Range
     Set Rng = .Find(What:=Find_Item, LookIn:=LookIn, LookAt:=LookAt, _
             SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, MatchCase:=MatchCase, SearchFormat:=False)
       If Not Rng Is Nothing Then
        Set Find_Range = Rng
         firstAddress = Rng.Address
         Do
            Set Find_Range = Union(Find_Range, Rng)
            Set Rng = .FindNext(Rng)
         Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
     End If
   End With
End Function

Mã:
Private Sub CommandButton1_Click()
If Val(Me.TextBox1) * Val(Me.TextBox2) = 0 Then MsgBox "CHUA CO SO LIEU": Exit Sub
        Sheets("MAI TU").Range("A65000").End(xlUp).Offset(1, 0).Select
      With ActiveCell
            .Value = UserForm1.DTPicker3.Value
            .Offset(0, 1) = TextBox1 * 1
            .Offset(0, 2) = TextBox2 * 1
            .Offset(0, 3) = TextBox1 * 0.6
            .Offset(0, 4).Value = "=RC[-1]/2-RC[-2]"
            .Offset(0, 5).Value = "=RC[-2]/2+RC[-3]"
            .Offset(0, 6).Value = "=RC[-1]+RC[-2]"
        End With
            Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
                          
End Sub
PHP:
Private Sub CommandButton7_Click()
       Dim mypassword
tryagain:
    mypassword = InputBox("PLEASE ENTER PASSWORD", "YOUR PASSWORD")
    If mypassword = "maitram" Then 'your code here'
    MsgBox ("Correct")
   Else
      If MsgBox("PASSWORD INCORRECT, TRY AGAIN?", vbYesNo, Title:="WRONG PASSWORD") = vbYesNo Then GoTo tryagain
End If

    
    Dim CashValue, CheckValue, TotalValue
    TotalValue = 0
    CheckValue = 0
    CashValue = 0
    Range("A1").Select
    Do Until ActiveCell.Value = Empty
    If ActiveCell.Value = "DATE" Then
        ActiveCell.Offset(1, 0).Select
        
    ElseIf DateValue(ActiveCell.Value) = DateValue(UserForm1.DTPicker1) Or _
        DateValue(ActiveCell.Value) > DateValue(UserForm1.DTPicker1) Then
            If DateValue(ActiveCell.Value) = DateValue(UserForm1.DTPicker2.Value) Or _
                DateValue(ActiveCell.Value) < DateValue(UserForm1.DTPicker2.Value) Then
            
                CashValue = CashValue + ActiveCell.Offset(0, 4)
                CheckValue = CheckValue + ActiveCell.Offset(0, 5)
                TotalValue = TotalValue + ActiveCell.Offset(0, 6)
                ActiveCell.Offset(1, 0).Select
            Else
                ActiveCell.Offset(1, 0).Select
            End If
       
      
    Else
        ActiveCell.Offset(1, 0).Select
    End If
    
    Loop
    Select Case TotalValue
        Case 0
            UserForm1.TextBox3.Value = "$" & "0"
        Case Is > 0
            UserForm1.TextBox3.Value = "$" & TotalValue
    End Select
    Select Case CheckValue
        Case 0
            UserForm1.TextBox5.Value = "$" & "0"
        Case Is > 0
            UserForm1.TextBox5.Value = "$" & CheckValue
    End Select
    Select Case CashValue
        Case 0
            UserForm1.TextBox4.Value = "$" & "0"
        Case Is > 0
            UserForm1.TextBox4.Value = "$" & CashValue
    End Select
    End Sub
       Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
    Cancel = True
    End If
    If MsgBox("EXIT PROGRAM?", vbYesNo + vbQuestion, Title:="JOLIE'S NAIL SPA") = _
          vbNo Then
        Exit Sub
    Else
        Unload UserForm1
    End If
    With Application
        .Calculation = xlCalculationAutomatic:        .Visible = True
        .ScreenUpdating = True:                         .EnableEvents = True
        .DisplayAlerts = False:                            .IgnoreRemoteRequests = False
        .Quit
    End With
End Sub
Mã:
Private Sub UserForm_Initialize()
Call MinMax(UserForm1.Caption)
H1 = UserForm1.Height
UserForm1.Height = 0
H2 = UserForm1.InsideWidth
UserForm1.Height = H1
End Sub
 
Lần chỉnh sửa cuối:
Trước mắt thấy ngay chỗ này:
Mã:
If MsgBox("PASSWORD INCORRECT, TRY AGAIN?", vbYesNo, Title:="WRONG PASSWORD") = [B][COLOR="Red"]vbYesNo[/COLOR][/B] _
 Then GoTo tryagain

Lẽ ra là vbYes
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom