Excel Forum

Code: Select all

Application.ScreenUpdating = True

Code: Select all

Application.ScreenUpdating = False

Code: Select all

Application.ScreenUpdating = True

Code: Select all

Private Sub CommandButton1_Click()
Dim wx As Variant
'On Error Resume Next
Application.ScreenUpdating = False
Set wx = Workbooks.Open("C:\Program Files\DumP\DATA\doc\" & ComboBox1 & ".doc", True, True)
wx.PrintOut
wx.Close False
Application.ScreenUpdating = True
'If Err > 0 Then
'MsgBox "Notfound Doc"
'End If
End Sub

Code: Select all

Sub OpenWordPrintAndClose()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = New Word.Application
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open("D:\Test.docx")
wdApp.PrintOut
wdApp.Quit
Set wdApp = Nothing
End Sub

Code: Select all

ActiveWindow.WindowState = xlMinimized

Code: Select all

Application.ThisWorkbook.FollowHyperlink "http://lotusnotes02/handbook/main.nsf"

Code: Select all

Sheets("FileC").Activate
r = 2
Do Until Sheet10.Cells(r, 1).Value = ""
If Sheet10.Cells(r, 4).Value = 0 And Sheet10.Cells(r,2) And Sheet10.Cells(r,3) Then
......'คำสั่งที่ลบแถวCells(r, 4)ทั้งแถว
r = r + 1
frmlone.TextBox1.Value = Sheet9.Range("AB1").Value'ที่ตำแหน่งนี้มีการคำนวณเปอร์เซ็น
DoEvents
Loop

Code: Select all

frmlone.TextBox1.Value = Sheet9.Range("AB1").Value

Code: Select all

frmlone.TextBox1.Value = Sheet9.Range("AB1").Value'ที่ตำแหน่งนี้มีการคำนวณเปอร์เซ็น
DoEvents

Code: Select all

Dim rAll As Range
Dim r As Range
With Worksheets("Sheet2")
    Set rAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
End With
For Each r In rAll
    If r = 0 And r.Offset(0, 1) = 0 And r.Offset(0, 2) = 0 Then
        r = ""
    End If
frmlone.TextBox1.Value = Sheet9.Range("AB1").Value'ลองเพิ่มเข้าไป
Next r
    On Error Resume Next
    rAll.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Code: Select all

Sub Sed()
Dim r As Integer
Sheets("Sheet2").Activate
 r = 2
Do Until Sheet2.Cells(r, 1).Value = ""
If Sheet2.Cells(r, 5).Value = 0 Then
Sheet2.Rows(r).Select
Selection.Delete Shift:=xlUp
End If
r = r + 1
UserForm1.TextBox1.Value = Sheet2.Range("AB1").Value 
DoEvents
Loop
End Sub

Code: Select all

Sub Sed()
Dim r As Integer
With Worksheets("Sheet2")
    .Activate
    r = .Range("A1").End(xlDown).Row
    Do Until r = 1
        If .Cells(r, 5).Value = 0 Then
            .Cells(r, 5).EntireRow.Delete
        End If
        r = r - 1
        UserForm1.TextBox1.Value = .Range("AB1").Value
        DoEvents
    Loop
End With
End Sub

Code: Select all

Sub a
Dim r As interger
Dim n As interger
 With Worksheets("Sheet2")
    .Activate
    r = 2
    n = Sheet2.Range("AC1").value 
      Do Until Sheet10.Cells(r, 1).Value = ""
Sheet10.Cells(r, 6).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A1:T(n),3,0)"
Sheet10.Cells(r, 7).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6).Address & ",FileA!A1:G(n),5,0)" 
Sheet10.Cells(r, 8).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6) & ",FileA!A1:G(n),7,0)" 
Sheet10.Cells(r, 9).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 1) & ",FileB!A1:T(n),17,0)"
Sheet10.Cells(r, 23).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6) & ",FileA1!A1:G(n),3,0)"
TextBox7.Value = Sheet10.Range("P1").Value
DoEvents
r = r + 1
LoopEnd With
End Sub

Code: Select all

"=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A1:T(n),3,0)"

Code: Select all

Application.Calculation = xlCalculationManual

Code: Select all

Application.Calculation = xlCalculationAutomatic