Import TextFiles & Text2Column

Sub Import_File()

Dim X As Double

Dim TXT As String

Open "D:\99_Report_Sample\2019_08_26_SUMGL.txt" _

For Input As #1 'Change Directory For File Location'

X = 0

Do While Not EOF(1)

Line Input #1, TXT

Cells(1, 1).Offset(X, 0) = TXT

X = X + 1

Loop

Close #1

End Sub
------------------------------------------------------
Sub Text2Column()

Dim rng As Range

Dim sh As Worksheet

Set sh = Worksheets("GL_WP") '=>Change the sheet Name'

With sh

Set rng = .[A1]

Set rng = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp))

rng.TextToColumns Destination:=rng, DataType:=xlFixedWidth, _

TextQualifier:=xlFixedWidth, _

Tab:=False, _

Semicolon:=False, _

Comma:=True, Space:=False, Other:=False, _

FieldInfo:=Array(Array(0, 1), Array(11, 1), Array(41, 1), Array(75, 1), Array(95, 1), _

Array(119, 1), Array(143, 1)), TrailingMinusNumbers:=True

End With

End Sub

VB Excel VLOOKUP

Private Sub Worksheet_Change(ByVal Target As range)

Set WB = ThisWorkbook

Set WT = WB.Worksheets("TEAM")

Set WC = WB.Worksheets("COACH")

lrow = range("E" & Rows.Count).End(xlUp).Row

nrow = range("F" & Rows.Count).End(xlUp).Row

On Error GoTo MyErrorHandler:

If Not Intersect(Target, WT.range("E:E")) Is Nothing Then

'MsgBox "Changed my range!"

d = 2

For i = 2 To lrow

If range("E" & i) <> "" Then

WT.range("F" & i).Value = WorksheetFunction.

IfError((WorksheetFunction.

VLookup(WT.range("E" & i),

WC.range("A2:D50"), 3, 0)), "")

d = d + 1

Else

WT.range("F" & i).Value = ""

d = d + 1

End If

Next i

If WT.range("F" & i) <> "" And WT.range("E" & i) = "" Then

WT.range("F" & i).ClearContents

d = d + 1

End If

End If

For n = 2 To nrow

If WT.range("F" & nrow) <> "" And WT.range("E" & nrow) = "" Then

WT.range("F" & nrow).ClearContents

End If

Next n

MyErrorHandler:

If Err.Number = 1004 Then

range("F" & i) = "Not available"

End If

End Sub

Excel VB_Day1

Sub Button1_Click()

' MsgBox "Hello World"

Cells(3, 2).Value = 10

Range("C4").Value = 20

Range("A2:A10").Value = 5

Range("D2:D5,F5:F10").Value = 30

End Sub

Sub btn_sale1

'By Sheet Name

Worksheets("Sale").Range("A2").Value = 20

'Sheets("Sale").Range("A2").Value = 20

Worksheets("Summary").Range("A1").Value = "No"

'By Sheet Index Number

'Sheets(1).Range("G1").Value = "Name"

Worksheets(3).Range("G1").Value = "Name"

'By sheet code name

Sheet3.Range("E3").Value = 50

End Sub

Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub
Sub Consolidate_Workbooks()

End Sub

Consolidate_Workbooks

Sub Consolidate_Workbooks()

Set wb = ThisWorkbook

Set ws = wb.Worksheets("Data")

ws.Range("A3:M" & Rows.Count).ClearContents

Location = wb.Path & "\"

Filename = Dir(Location & "*.xlsx")

d = 3

Do While Filename <> ""

Workbooks.Open (Location & Filename)

lrow = Range("A3").CurrentRegion.Rows.Count

For r = 3 To lrow

ws.Range("A" & d & ":M" & d).Value = Range("A" & r & ":M" & r).Value

d = d + 1

Next r

Workbooks(Filename).Close

Filename = Dir

Loop

End Sub

របៀបអានភាសាបាលី

បញ្ចូលពត៌មានពី Excel ទៅ​ PDF ជាមួយ Marcro

១ -  ពិនិត្យតំណភ្ជាប់រវាង Excel និង​PDF ដោយចូលទៅ Macro (Alt+F11)

ដោយចូលទៅ Macro ឬ(Alt+F11)​ => Tool => Reference

ចុចយកពាក្យ Acrobat => Ok

២ -  ទាញយក Field នីមួយៗនៅក្នុង ​PDF មកដាក់នៅក្នុង Excel

Sub ReadAdobeField()

row_number = 1

Dim AcrobatApplication As Acrobat.CAcroApp
Dim AcrobatDocument As Acrobat.CAcroAVDoc
Dim fcount As Long
Dim sFieldName As String

On Error Resume Next
Set AcrobatApplication = CreateObject("AcroExch.App")
Set AcrobatDocument = CreateObject("AcroExch.AVDoc")

Location = Range("M5").Value 'Refer to

If AcrobatDocument.Open(Location, "") Then
AcrobatApplication.Show
Set AcroForm = CreateObject("AFormAut.App")
Set Fields = AcroForm.Fields
fcount = Fields.Count

For Each Field In Fields
row_number = row_number + 1
sFieldName = Field.Name

Sheet1.Range("B" & row_number) = Field.Name
Sheet1.Range("C" & row_number) = Field.Value
Sheet1.Range("D" & row_number) = Field.Style

Next Field

Else
MsgBox "Failure"

End If
AcrobatApplication.Exit
Set AcrobatApplication = Nothing
Set AcrobatDocument = Nothing
Set Field = Nothing
Set Fields = Nothing
End Sub

៣ -  បញ្ចូលពត៌មានតាមField នីមួយៗនៅក្នុង ​PDF

Sub WriteToPDF()

Dim AcrobatApplication As Acrobat.CAcroApp
Dim AcrobatDocument As Acrobat.CAcroAVDoc
Dim fcount As Long
Dim sFieldName As String

Set AcrobatApplication = CreateObject("AcroExch.App")
Set AcrobatDocument = CreateObject("AcroExch.AVDoc")

Location = Range("M5").Value

If AcrobatDocument.Open(Location, "") Then

AcrobatApplication.Show
Set AcroForm = CreateObject("AFormAut.App")
Set Fields = AcroForm.Fields
fcount = Fields.Count

'Fields("Text1").Value = Range("C2").Value
'Fields("Text5").Value = Range("C3").Value
'Fields("Check Box8").Value = Range("C4").Value

Else
MsgBox "Failure"

End If
AcrobatApplication.Exit
Set AcrobatApplication = Nothing
Set AcrobatDocument = Nothing
Set Field = Nothing
Set Fields = Nothing

End Sub

៤ -  ការប្រើប្រាស់ផ្សេងៗ

1. Location:
=LEFT(CELL("filename",C11),FIND("[",CELL("filename",C11))-1)
2. File Name
=SUBSTITUTE(CELL("filename"),RIGHT(CELL("filename"),LEN(CELL("filename"))-FIND("@",SUBSTITUTE(CELL("filename"),"\","@",LEN(CELL("filename"))-LEN(SUBSTITUTE(CELL("filename"),"\",""))),1)),"*")
Formulas => Name Manager => Name(FileNameList)=> Refers to (FILES(-sheetname--row&columname--)
=IFERROR(INDEX(FileName,L3),"")