Lập trình VBA nhanh hơn với thủ tục DBPrint (Cập nhật: 06/02/2019)

[HeSanbi]

Chia sẻ cho mọi người một code lập trình VBA thuận tiện trong việc học cũng như viết code phát triển ứng dụng trong VBA

Code sẽ giúp các bạn có thể xem trước kết quả của một mảng nhanh hơn. Không cần phải chuyển sang Workbook mỗi lần chạy code mà có thể xem kết quả ngay trong cửa sổ lập trình VBA - Immediate.
Bản Cập nhật mới: 06/02/2019 22:30
Thêm điều chỉnh khung VBE và cửa sổ Immediate khi kiểm thử
Nâng cấp thành Add-ins để hoạt động trên nhiều File và các phiên bản Excel chạy song song
Thêm một số hàm:

Alert - Thay cho MsgBox để tự động tắt sau vài giây​

AlertH - Thay cho MsgBox để tự động tắt khi rê chuột vào (hỗ trợ tiếng Việt )​

AlertUni - thông báo tiếng Việt theo hai kiểu gõ Telex và VNI​

---------------------------------------------------------------------------------------
Tiện ích của hàm:
In nhanh chóng để xem thử kết quả Mảng, Dictionary, Collection,
Mảng trong Mảng, Multi Range.
Hiển thị Thứ tự hàng và cột khi ghi giả định một mảng như khi ghi vào trang tính để
xem trước kết quả trước khi đưa vào Trang tính
---------------------------------------------------------------------------------------
dbPrint [DataImport], [HasTitle] ,[punc] , [HasType] , [SeriSeat],[wMinCol ], [wMaxCol ],[pMain] , [pType],[MaxType],[RngStartRow],[RngStartCol],[AlignStr],[imLeft],[imTop],[imWidth],[imHeight],[Ti]

Sử dụng:
Cách sử dụng đơn giản nhất:
dbPrint Array(0, 1, 2, 3)
Cách sử dụng chuyên nghiệp hơn:
Để sử dụng từng đối số hãy nhập Tên của Đối số trong Hàm DbPrint cùng dấu ( := ) hoặc nhập đúng vị trí của đối số hoặc bỏ qua đối số bằng cách thêm hai dấu phẩy ( ,, ) :
dbPrint DataImport:=Array(1,2), HasTitle:=True ,punc:="", HasType:=False , SeriSeat:=7, wMinCol:=6, wMaxCol:=26,pMain , pType:=".",MaxType:=1,RngStartRow:=0,RngStartCol:=0,Ti:=5

1. [DataImport] - Đối tượng để ghi vào immediate ( hãy thử nhập vào bất kì đối tượng nào)
2. [HasTitle] - mảng có /không tiêu đề
3. [punc] - thêm ký tự đứng trước ("" thì tự động đánh thứ tự)
4. [HasType] - trả về / không trả về Type trong mảng 2D
5. [SeriSeat] - khoảng trống dành cho số dòng
6. [wMinCol ] - giới hạn độ rộng nhỏ nhất
7. [wMaxCol ] - giới hạn độ rộng của chuỗi dài nhất trong cột của mảng
8. [pMain] - Ký tự giản cách trong khoảng giới hạn độ rộng
9. [pType] - dấu phân cách trước Type
10. [MaxType ] - Độ rộng cho Type
11. [RngStartRow] - Vị trí dòng muốn in giả định (phụ thuộc RngStartCol)
12. [RngStartCol] - Vị trí cột muốn in giả định (phụ thuộc RngStartRow )
13. [AlignStr] - Căn chỉnh chuỗi in trong mảng 2 chiều

AlignStr = 1: Căn trái , 2 căn giữa, 3 căn phải​

14. [imLeft] - Vị trí cửa sổ Immediate tính từ giới hạn trái màn hình
15. [imTop] - Vị trí cửa sổ Immediate tính từ giới hạn trên màn hình
16. [imWidth] - Độ rộng cửa sổ Immediate
17. [imHeight] - Chiều cao cửa sổ Immediate
18. [Ti ] - Sẽ làm sạch cửa sổ Immediate sau một thời gian (mặc định 5 giây) , Nếu đặt là 0 thì vô hiệu hóa việc làm sạch

Để ghi kết quả giả định Trang tính Excel trong cửa sổ Immediate
Hãy sử dụng hai tham số: RngStartRow và RngStartCol
Ví dụ muốn ghi mảng Arr(1 to 10, 10 to 10) vào Range("C5") thì RngStartRow nhận 5 (Range("C5").Row), RngStartCol nhận 3 (Range("C5").Column)

Cần cho phép trung tâm tin cậy để bật khung Immediate tự động:
Trust access to the VBA project object model

1. Mở Microsoft Excel.
2. Mở một workbook.
3. Chọn File , chọn Options. (Tùy chọn)
4. Vào Trust Center. (Trung tâm tin cậy)
5. Vào Click Trust Center Settings.... (Thiết đặt trung tâm tin cậy)
6. Chọn Macro Settings. (Thiết đặt Macro)
7. Đánh dấu Trust access to the VBA project object model (Cho phép truy cập mô hình đối tượng ...)
8. Ấn OK.

Trong khi sử dụng nếu các bạn gặp lỗi hãy báo lỗi tại bài viết này, để kịp thời sửa chữa.

Bản hiện tại:
- Xem thử kết quả có đầu đề cột và số dòng


Trước khi tải file về sử dụng hãy Scan Virus tại: https://www.virustotal.com/vi/
hoặc khi bắt đầu mở File cho phép chỉnh sửa, không chọn cho phép Macro. Vào VBE đọc mã nguồn để tránh nguy hiểm cho Máy tính của các bạn.

Các bạn đặt Add-In vào XLSTART để dùng cho nhiều File và cho cả hai phiên bản Excel chạy song song

Liên hệ:
Mail: wazzateo@gmail.com
Facebook: fb.com/he.sanbi hoặc tìm kiếm he.sanbi
Link Donate - Link ủng hộ (Hoặc Facebook)

 

[VetMini]

Hoành tráng thiệt. Nhưng mà công dụng là gì? Cho thử một trường hợp cần sử dụng.

 

[HeSanbi]

Hoành tráng thiệt. Nhưng mà công dụng là gì? Cho thử một trường hợp cần sử dụng.

Vì muốn xem trước một mảng trực tiếp trên IDE, VBA lại không hỗ trợ, đang viết code mà cứ chọn Workbook để xem thử kết quả rồi chuyển sang IDE để viết code thì rất chán. Có cái Immediate ngay trên IDE mà không dùng thì phí quá. Công dụng của nó thì do Coder sáng tạo. chứ công dụng ở đây là xem trước một mảng 2D sao cho dể nhìn, dể nhận biết kết quả...

 

[VetMini]

Chạy thử code này xem

Sub test_dbPrint()
Dim arr() As Variant
'arr = sheet1.[C5:E24].Value
'arr = Array(1.7, 2, "3", , 5, True, vbNewLine, 10000000, 1 / 2)
ReDim arr(1 To 10000, 1 To 100) ' 100000 sẽ bị overflow
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
arr(i, j) = i * 100 + j
Next j
Next i
dbPrint arr, , True
End Sub

 

[HeSanbi]

.

 

[VetMini]

Anh VetMini chú ý 1 chút:
....

Tôi là dân tét cốt có bằng cấp. Trong bài #1, bạn hỏi nhờ "góp ý" thì việc đầu tiên tôi làm là tét giới hạn của nó. Đó là công việc đầu tiên của tét cốt. Và tôi không cần phải chú ý chú ía gì cả.
Hết

 

[Hoàng Nhật Phương]

Chia sẻ cho mọi người một code xem trước kết quả trong cửa sổ Immediate
code còn sơ sài , lủng củng, rối qua rối lại, nên mong mọi xem sét góp ý và chỉnh sữa thêm
Sử dụng:
- Với mảng:
call dbPrint([im], [arrayHeader] ,[punc] , [reTypeArray2D] , [widthCol ])
hoặc dbPrint [im] ,[arrayHeader] ,[punc] ,[reTypeArray2D] ,[widthCol ]
- Với các đối tượng đơn: số, chuỗi, double, variant,... :
dbPrint <..> thay cho: Debug.Print <..> (mỗi lần kiểm thử mà đánh chữ "debug" lại còn "." rồi "print")
1. [im] - Đối tượng để in ( hãy thử nhập vào bất kì đối tượng nào)
2. [arrayHeader] - mảng có /không tiêu đề
3. [punc] - thêm ký tự đứng trước (có hoặc không)
4. [reTypeArray2D] - trả về / không trả về Type
5. [widthCol ] - giới hạn độ rộng của chuỗi dài nhất
View attachment 206009

Sub test_dbPrint()
    Dim arr() As Variant
    'arr = sheet1.[C5:E24].Value
    arr = Array(1.7, 2, "3", , 5, True, vbNewLine, 10000000, 1 / 2)
    dbPrint arr, True, , True
End Sub
    Function dbPrint(Optional ByVal im, _
                     Optional arrayHeader As Boolean = False, _
                     Optional punc As String = "", _
                     Optional reTypeArray2D As Boolean = False, _
                     Optional widthCol As Integer = 25)
        viewImmediate (True)
        If IsMissing(im) Then Debug.Print "<Missing>": Exit Function
        Dim cell As Variant, ubIM As Long, i As Long: i = 0:
        Dim m As Integer, mHeader As String, n As Integer, jString As String, reTypeStr As String
        Dim lArr() As Variant, puncW As String, puncH As String
        puncW = "|  ": puncH = "|  "
        If IsArray(im) Then
            Debug.Print VBA.String(2, vbNewLine)
            If bool_array2d(im) Then
                Debug.Print "---------------- IsArray 2D ----------------" & vbNewLine
                ReDim lArr(1 To UBound(im, 2))
                For n = LBound(im, 2) To UBound(im, 2)
                    lArr(n) = 5
                Next n
                For m = LBound(im) To UBound(im)
                    For n = LBound(im, 2) To UBound(im, 2)
                        If Len(im(m, n)) > lArr(n) Then lArr(n) = Len(im(m, n))
                        If lArr(n) > widthCol Then lArr(n) = widthCol
                    Next n
                Next m
                For m = LBound(im) To UBound(im)
                    mHeader = m + arrayHeader
                    If punc <> "" Then mHeader = punc

                    jString = ""
                    For n = LBound(im, 2) To UBound(im, 2)
                        widthCol = lArr(n) + 2
                        If reTypeArray2D Then
                            puncW = ""
                            reTypeStr = add_CharToString_LR(reType(im(m, n)), , , " ", "-> ", "|  ", 18)
                            If m = 1 And arrayHeader Then
                                reTypeStr = add_CharToString_LR("Type", , , " ", "-> ", "|  ", 18)
                            End If
                        End If
                   
                        jString = jString & add_CharToString_LR(im(m, n), , , " ", , puncW, widthCol) & reTypeStr
                    Next n
                    If m = 1 And arrayHeader Then
                        If punc = vbNullString Then
                            mHeader = ""
                        Else
                            mHeader = add_CharToString_LR(, , , " ", , "", UBound(im, 2))
                        End If
                    End If
                    Debug.Print mHeader & vbTab & jString
                    If m = 1 And arrayHeader Then
                   
                        Debug.Print punc & add_CharToString_LR(, , , "-", , puncW, widthCol, UBound(im, 2))
                    End If
                 Next m
            Else
                Debug.Print "---------------- IsArray 1D ----------------" & vbNewLine
                On Error Resume Next
                ubIM = UBound(im)
                If Err.Number <> 0 Then Debug.Print "Array Empty": Exit Function


                For Each cell In im
                    cell = reStrConstants(cell)
                    If IsObject(cell) Then Debug.Print "Array contains object. Can't print !": Exit Function
                    If IsMissing(cell) Then cell = "<Missing!>"
                    i = i + 1
                    mHeader = i
                    If punc <> "" Then mHeader = punc
                    Debug.Print mHeader & vbTab & add_CharToString_LR(cell, , , , , , widthCol) & " -> " & reType(cell)

                Next cell
            End If
       
            Debug.Print vbNewLine & "---------------- End Array ----------------"
            If UBound(im) > 200 Then: Debug.Print "*Warning: Immediate - limit the results - 200 rows"
        Else
            If VarType(im) = vbObject Then Debug.Print "Can't Print a Object": Exit Function
            Debug.Print vbCr & im & " -> " & reType(im)
        End If

    End Function
Sub test_reType()
    dbPrint reType(1)
End Sub
    Public Function reType(Optional ByVal im) As String
        If IsMissing(im) Then reType = "<Missing>": Exit Function
        If VarType(im) = vbArray Then
            reType = "vbArray"
        ElseIf VarType(im) = vbEmpty Then reType = "vbEmpty"
        ElseIf VarType(im) = vbNull Then reType = "vbNull"
        ElseIf VarType(im) = vbInteger Then reType = "vbInteger"
        ElseIf VarType(im) = vbLong Then reType = "vbLong"
        ElseIf VarType(im) = vbSingle Then reType = "vbSingle"
        ElseIf VarType(im) = vbDouble Then reType = "vbDouble"
        ElseIf VarType(im) = vbCurrency Then reType = "vbCurrency"
        ElseIf VarType(im) = vbDate Then reType = "vbDate"
        ElseIf VarType(im) = vbString Then
            reType = "vbString"
            If vbStrConstants(im) Then reType = "vbStrConstants"
        ElseIf VarType(im) = vbObject Then reType = "vbObject"
        ElseIf VarType(im) = vbError Then reType = "vbError"
        ElseIf VarType(im) = vbBoolean Then reType = "vbBoolean"
        ElseIf VarType(im) = vbVariant Then reType = "vbVariant"
        ElseIf VarType(im) = vbDataObject Then reType = "vbDataObject"
        ElseIf VarType(im) = vbDecimal Then reType = "vbDecimal"
        ElseIf VarType(im) = vbByte Then reType = "vbByte"
        ElseIf VarType(im) = vbUserDefinedType Then reType = "vbUserDefinedType"
        ElseIf VarType(im) = vbLongLong Then reType = "vbLongLong"
        Else
            reType = im
        End If
    End Function
Sub test_vbStrConstants()
    dbPrint vbStrConstants("vbEmpty")
End Sub
    Public Function vbStrConstants(Optional ByVal im As Variant) As Boolean
        If IsMissing(im) Then Exit Function
        If im = vbEmpty Or im = vbCr Or im = vbCrLf _
        Or im = vbFormFeed Or im = vbLf Or im = vbNewLine _
        Or im = vbNullChar Or im = vbNullString Or im = vbTab Or im = vbVerticalTab _
        Or im = "vbEmpty" Or im = "vbCr" Or im = "vbCrLf" _
        Or im = "vbFormFeed" Or im = "vbLf" Or im = "vbNewLine" _
        Or im = "vbNullChar" Or im = "vbNullString" Or im = "vbTab" Or im = "vbVerticalTab" Then _
        vbStrConstants = True
    End Function
Sub test_reStrConstants()
    dbPrint reStrConstants(vbEmpty)
End Sub
    Public Function reStrConstants(Optional ByVal im As Variant) As Variant
        reStrConstants = im
        If IsMissing(im) Then reStrConstants = "<Missing>": Exit Function
        If im = vbEmpty Then reStrConstants = "vbVerticalTab"
        If im = vbCr Then reStrConstants = "vbCr"
        If im = vbCrLf Then reStrConstants = "vbCrLf"
        If im = vbFormFeed Then reStrConstants = "vbFormFeed"
        If im = vbLf Then reStrConstants = "vbLf"
        If im = vbNewLine Then reStrConstants = "vbNewLine"
        If im = vbNullChar Then reStrConstants = "vbNullChar"
        If im = vbNullString Then reStrConstants = "vbNullString"
        If im = vbTab Then reStrConstants = "vbTab"
        If im = vbVerticalTab Then reStrConstants = "vbVerticalTab"
    End Function
Sub test_add_CharToString_LR()
    Dim em As String
    'em = add_CharToString_LR(, "bbbcbb", "ccccc", "-|", "\", "/", 32, 1)
    'em = add_CharToString_LR("aaaaaa", , , "-|", "\", "/", 30, 1)
    'em = add_CharToString_LR(, "bbbbb", , "-", "\", "/", 30, 1)
    'em = add_CharToString_LR(, , "ccccaaaaaaaaaaaaaaaaaaaaaaaaac", "-", "\", "/", 6, 1)
    'em = add_CharToString_LR("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", , "ccccc", "-|", "\", "/", 30, 1)
    'em = add_CharToString_LR("aaaaaaaaaaaaaaaa", "bbbbbbbbbbbbbbb", "ccccccccccccccc", "-", "\", "/", 6, 1)
    em = add_CharToString_LR(, "bbbbbbbbbbbbbbb", "ccccccccccccccc", "-", "\", "/", 30, 1)
    Debug.Print em & " len: " & Len(em)
End Sub
    Function add_CharToString_LR(Optional ByVal strL As Variant = "", _
                                Optional ByVal strC As Variant = "", _
                                Optional ByVal strR As Variant = "", _
                                Optional ByVal MainChar As Variant = " ", _
                                Optional ByVal charL As Variant = "", _
                                Optional ByVal charR As Variant = "", _
                                Optional ByVal limitStr As Integer = 25, _
                                Optional ByVal loopStr As Long = 1) As String
                                Rem strL:      String of align - Left      | strL = "This"
                                Rem strR:      String of align - Right     | strR = "Is"
                                Rem strC:      String of align - Center    | strC = "VBA"
                                Rem MainChar:  Character of align          | MainChar = "-"
                                Rem charL:     Character of left String    | charL = "\"
                                Rem charR:     Character of right String   | charR = "/"
                                Rem limitStr:  Character of right String   | limitStr = 30
                                Rem loopStr:   Character of right String   | loopStr = 1
                                'Copy Example to sub or function: add_CharToString_LR("This", "Is","VBA" , "-", "\","/",30, 1)
        If IsMissing(strL) Or IsMissing(strC) Or IsMissing(strR) Then add_CharToString_LR = add_CharToString_LR("<Missing>", , , , , , limitStr): Exit Function
   
        If strL <> "" And strC <> "" And strR = "" Or _
            strL = "" And strC <> "" And strR <> "" Then _
            add_CharToString_LR = add_CharToString_LR(, "Limit", , "!", , , limitStr): Exit Function
        Dim char_L As String, char_R As String
        Dim reStr As String, charD As String, i As Integer, j As Integer
        '-----------------------------------------------------
        Dim lenL As Integer: lenL = Len(strL)
        Dim lenC As Integer: lenC = Len(strC)
        Dim lenR As Integer: lenR = Len(strR)
        Dim LenChrL As Integer: LenChrL = Len(charL)
        Dim LenChrR As Integer: LenChrR = Len(charR)
        '-----------------------------------------------------
        Dim LenChrM As Integer: LenChrM = Len(MainChar)
        '-----------------------------------------------------
        Dim sumLenChr As Integer: sumLenChr = LenChrL + LenChrR
        Dim sumLen As Integer: sumLen = lenL + lenC + lenR + sumLenChr
        Dim numCharM As Integer: numCharM = limitStr - sumLen
        '-----------------------------------------------------
        Dim lenCharML As Integer: lenCharML = Application.WorksheetFunction.RoundDown(numCharM / 2, 0)
        Dim lenCharMR As Integer: lenCharMR = lenCharML + numCharM Mod 2
        '-----------------------------------------------------
        Dim modStr As Integer: modStr = (limitStr - sumLenChr) Mod 3
        Dim lenStr As Integer: lenStr = Application.WorksheetFunction.RoundDown((limitStr - sumLenChr) / 3, 0)
        '-----------------------------------------------------
        Dim lenStr2 As Integer: lenStr2 = Application.WorksheetFunction.RoundDown((limitStr - sumLenChr - 2) / 2, 0)
        Dim modStr2 As Integer: modStr2 = (limitStr - sumLenChr - 2) Mod 2
        '-----------------------------------------------------
            If strL <> vbNullString And strC <> vbNullString And strR <> vbNullString Then
                If sumLen > limitStr Then
                    add_CharToString_LR = newStrChar("!", limitStr, 5)
                    If limitStr > 5 Then add_CharToString_LR = "limit" & newStrChar("!", limitStr - 5, 5)
                    Exit Function
                End If
                    '---------------------------
            ElseIf strL <> vbNullString And strC = vbNullString And strR = vbNullString Then
           
                If sumLen > limitStr Then
                    strL = Left(strL, limitStr - sumLenChr - 2) & ".."
                Else
                    lenCharML = numCharM: lenCharMR = 0
                End If
                    '---------------------------
            ElseIf strL = vbNullString And strC <> vbNullString And strR = vbNullString Then
                If sumLen > limitStr Then _
                    strC = Left(strC, limitStr - sumLenChr - 2) & ".."
                    '---------------------------
            ElseIf strL = vbNullString And strC = vbNullString And strR <> vbNullString Then
                If sumLen > limitStr Then
                    strR = Left(strR, limitStr - sumLenChr - 2) & ".."
                Else
                    lenCharML = numCharM: lenCharMR = 0
                End If
                    '---------------------------
            ElseIf strL = vbNullString And strC = vbNullString And strR = vbNullString Then
                    '---- Nothing---------------
            Else
                If sumLen > limitStr Then
                    add_CharToString_LR = newStrChar("!", limitStr, 5)
                    If limitStr > 5 Then add_CharToString_LR = add_CharToString_LR(, "Limit", , "!", , , limitStr)
               
                    Exit Function
                Else
                    lenCharML = numCharM: lenCharMR = 0
                End If
           
            End If
            char_L = newStrChar(MainChar, lenCharML, Len(strL))
            char_R = newStrChar(MainChar, lenCharMR, Len(strL) + lenCharML + Len(strC))
        '--------------------Result DEMO---------------------
            reStr = charL & strL & char_L & strC & char_R & strR & charR
        '-----------------------------------------------------
            For i = 1 To loopStr
                add_CharToString_LR = add_CharToString_LR & reStr
            Next
    End Function
Sub test_newStrChar()
    Dim em As String
    em = newStrChar("->", 45, Len("helloa"))
    Debug.Print em & " len: " & Len(em)
End Sub
    Function newStrChar(Optional ByVal strChar As Variant = " ", _
                        Optional ByVal limitChar As Integer, _
                        Optional ByVal LStart As Integer)
        If limitChar <= 0 Then newStrChar = "": Exit Function
        Dim i As Integer, m As Integer, n As Integer, k As Integer, arr() As Variant
        k = Len(strChar): m = 0: n = 0
        ReDim arr(limitChar - 1)
        Do
            For i = 1 To k
                If m >= LStart Then: arr(n) = Mid(strChar, i, 1): n = n + 1
                m = m + 1
                If n = limitChar Then GoTo Result
            Next i
        Loop While True
Result: newStrChar = Join(arr, "")
    End Function
    Function bool_array2d(arr As Variant) As Boolean
        Dim i As Long
        On Error Resume Next
        i = LBound(arr, 2)
        bool_array2d = Err = 0
    End Function
    Function viewImmediate(Optional view As Boolean = True) As Boolean
        If view Then
            Application.VBE.Windows("Immediate").Visible = True
            viewImmediate = True
        Else
            Application.VBE.Windows("Immediate").Visible = False
            viewImmediate = False
        End If
    End Function

Xin chào minahnh0011,

Cảm ơn bạn đã chia sẻ code xem kết quả trong Immediate. Oanh Thơ cảm thấy rất hữu ích ,tiện cho học và tiếp xúc với code.
Hi vọng bạn sẽ có thêm những chia sẻ hữu ích khác nữa.

Chúc bạn luôn thành công.

 

[Hoàng Nhật Phương]

Xin chào minahnh0011,

5. [widthCol ] - giới hạn độ rộng của chuỗi dài nhất

Có phải hiện đang mặc định là 25 cột:

Optional widthCol As Integer = 25

Oanh Thơ chạy thử nếu độ rộng chuỗi > 25
Code báo lỗi,tại dòng:
Function add_CharToString_LR
....
strL = Left(strL, limitStr - sumLenChr - 2) & ".."
....
End Function
Ví dụ độ rộng của chuỗi dài nhất =29
nếu viết dbPrint arr, , , , 30(>độ rộng của chuỗi dài nhất) thì hết lỗi.
Bạn có thể xử lý lỗi, hoặc tạo cảnh báo,hoặc tự động tính toán cho: widthCol As Integer = 29 được không?

 

[HeSanbi]

Xin chào minahnh0011,


Có phải hiện đang mặc định là 25 cột:


Oanh Thơ chạy thử nếu độ rộng chuỗi > 25
Code báo lỗi,tại dòng:
Function add_CharToString_LR
....
strL = Left(strL, limitStr - sumLenChr - 2) & ".."
....
End Function
Ví dụ độ rộng của chuỗi dài nhất =29
nếu viết dbPrint arr, , , , 30(>độ rộng của chuỗi dài nhất) thì hết lỗi.
Bạn có thể xử lý lỗi, hoặc tạo cảnh báo,hoặc tự động tính toán cho: widthCol As Integer = 29 được không?

Đã cập nhật Code trên #1, Oanh Thơ chịu khó copy hết lại code nhé
cập nhật:
1. Đã Thay đổi hàm add_CharToString_LR thành addCharStrL ( add_CharToString_LR đang phát triển )
2. Đã Sữa biến trong dbPrint :
+thêm biến widthMinCol = 6: giới hạn độ rộng chuỗi nhỏ nhất trong cột của mảng - mặc định là 6 (tùy chỉnh)
+widthCol thành widthMaxCol = 25: giới hạn độ rộng chuỗi dài nhất trong cột của mảng - mặc định là 25 (tùy chỉnh)
+puncMain : màu mè hoa lá cho khoảng trắng
Vì trong dbPrint có vòng lặp duyệt Độ rộng này. Giá trị trong cột của mảng <widthMaxCol thì set widthMaxCol cột này của mảng thành
độ dài của giá trị. >=widthMaxCol giá trị là mặc định

 

[HeSanbi]

Cập nhật Hôm nay! @Nguyễn Hoàng Oanh Thơ

 

[Hoàng Nhật Phương]

Cập nhật Hôm nay! @Nguyễn Hoàng Oanh Thơ

Cảm minahnh0011, OT vẫn đang sử dụng chương trình này của bạn để học code.

 

[Kiều Mạnh]

MẠNH ko biết ứng nó nó vào cái chi ... tò mò test cái nó báo lỗi cũng ko biết làm sao luôn

 

[HeSanbi]

@Nguyễn Hoàng Oanh Thơ
OT Nói đến học Code, tôi có 1 số gợi ý:
1. Viết Cơ bản của VBA thành vào Sub đại diện - khi quên có thể mò lại (Module: BasicVBA, BasicXL, .....)
2. Cơ bản Application , VBE ( <> VBA ) , VBProject, Hướng đối tượng
3. Indent Code - Thụt lề cho code ( có cả một Code Auto riêng dành cho cái này)
4. Events
5. Viết Hàm nên thêm sub test_() cùng nó
6. Viết code Nâng Cao : Application.OnUndo cuối dòng code để Undo ( thường thì chạy code rồi không thể Undo )
7. Keyword search Google
...

 

[vanaccex]

Em chạy thử cũng bị lỗi như của anh @kieu manh . Có lẽ em thao tác sai cái gì đó rồi

 

[HeSanbi]

MẠNH ko biết ứng nó nó vào cái chi ... tò mò test cái nó báo lỗi cũng ko biết làm sao luôn

Cái hàm RandomString là nó tạo chuỗi bất kì để kiểm thử thôi. Tôi đã bỏ kiểm thử bằng cách này
Bạn thay RandomString thành chuỗi hay số tùy bạn đặt.
Bạn Redim Arr nhé. Lúc chỉnh sửa bài viết nhỡ xóa

Em chạy thử cũng bị lỗi như của anh @kieu manh . Có lẽ em thao tác sai cái gì đó rồi

Có vẻ như các bạn đang học code nhỉ

-------------------------------
Chủ yếu các bạn sử dụng dbPrint ấy
Chứ cái sub test_ là để thử thôi. Khi cập nhật bài viết quên cập nhật cho sub test_() ấy mà hoặc sửa xóa nhầm
Tương lai tôi sẽ có một ứng dụng học VBA - không biết khi nào

 

[huuthang_bd]

Em chạy thử cũng bị lỗi như của anh @kieu manh . Có lẽ em thao tác sai cái gì đó rồi

Xem code không biết lỗi à . Mảng arr chưa khai báo kích thước thì lấy đâu ra mà gán giá trị vào arr(i, j)
Phải vầy
Dim arr(1 to 5, 1 to 5)

 

[vanaccex]

Xem code không biết lỗi à . Mảng arr chưa khai báo kích thước thì lấy đâu ra mà gán giá trị vào arr(i, j)
Phải vầy
Dim arr(1 to 5, 1 to 5)

Test thì em cứ chạy bình thường thôi anh ! hehe :v

 

[HeSanbi]

Các bạn không những sử dụng mà nhớ cập nhật cho code nếu thấy hợp lí

 

[huuthang_bd]

Các bạn không những sử dụng mà nhớ cập nhật cho code nếu thấy hợp lí

Thấy anh em bảo lỗi nên nhảy vô coi

 

[Kiều Mạnh]

thử thêm cái nữa nó bị vầy ................. làm biếng coi lắm

Mà sao trước khi úp code Bạn ko test thử các kiểu 1 cái đi he ..................... hehehehe