Sửa code tự động căn chỉnh dòng khi in...

Liên hệ QC

S.Demon

Thành viên mới
Tham gia
23/10/12
Bài viết
6
Được thích
0
Mình đang dùng 1 file đc chia sẻ trong diễn đàn, mình cũng không rành VSB, nên nhờ anh em giúp mình sửa lại lỗi không tự căn chỉnh dòng khi in.
Cám ơn rất nhiều.

Mã:
Option Explicit


Function TransArr(sArr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    tmpX = UBound(sArr, 2):    tmpY = UBound(sArr, 1)
    ReDim tmpArr(tmpX, tmpY)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX, cllY) = sArr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr
End Function
Sub Locduynhat(t)
  
   Sheet7.ComboBox1.Clear
  
   On Error GoTo thoat:
  
   Dim vValue As Variant, vVals As Variant
   Dim myRange As Range
   Dim i As Long
   Dim dArr() As Variant
   Dim oDic As Object
   Set myRange = t
   'The Dictionary object is always present in Windows so it can always be created
   Set oDic = CreateObject("scripting.dictionary")
   oDic.comparemode = vbTextCompare
   'Read the values from a range into vVals
   vVals = myRange.Value
   'ReDim dArr and make it two dimensional by adding the second argument 1 To 1
   'otherwise you can't dump it in a worksheet later.
   ReDim dArr(UBound(vVals) - 1, 1 To 1)
   For Each vValue In vVals
      'Note the use of the Dictionary object to exclude double values
      If Not IsEmpty(vValue) And Not oDic.exists(vValue) Then
         Sheet7.ComboBox1.AddItem vValue
         oDic.Add vValue, Nothing
         i = i + 1
      End If
   Next vValue
  
   'Free memory by removing the Dictionary object and vVals from memory
   Set oDic = Nothing
   Erase vVals
   'Remove old data
   'Dump dArr values in worksheet
   'Set daura = Application.InputBox("vung dau ra", Type:=8)
   Erase dArr
thoat:
  
End Sub
Sub sub_laygiatri()
Dim tinh As Variant
Dim rng As Range
Dim t, i As Integer
t = 0
i = 0


Sheet7.Range("IN_NX_COGIAN").ClearContents
tinh = Application.Calculation
Application.Calculation = xlCalculationManual


' Lay gia tri cho phieu xuat
If (Sheet7.OptionButton2.Value = True) And (Sheet7.ComboBox1.Value <> "") Then
   For Each rng In Range("NK_XUAT_CHUNGTU")
       If rng.Value = Sheet7.ComboBox1.Value Then
          Sheet7.Range("D15").Value = rng.Offset(0, -1).Value
          Sheet7.Range("Q14").Value = rng.Offset(0, 1).Value
          Sheet7.Range("C17").Value = rng.Offset(0, 2).Value
          Sheet7.Range("H17").Value = rng.Offset(0, 3).Value
          Sheet7.Range("B19").Value = rng.Offset(0, 4).Value
          t = 1
          Exit For
       End If
    Next


    If t > 0 Then
       Do While rng.Value = Sheet7.ComboBox1.Value
          
          Sheet7.Range("A24").Offset(t - 1, 1).Value = rng.Offset(0, 6)
          Sheet7.Range("A24").Offset(t - 1, 5).Value = rng.Offset(0, 5)
          Sheet7.Range("A24").Offset(t - 1, 8).Value = rng.Offset(0, 8)
          Sheet7.Range("A24").Offset(t - 1, 6).Value = rng.Offset(0, 7)
          Sheet7.Range("A24").Offset(t - 1, 9).Value = rng.Offset(0, 9)
          Sheet7.Range("A24").Offset(t - 1, 10).Value = rng.Offset(0, 10)
          Sheet7.Range("A24").Offset(t - 1, 11).Value = rng.Offset(0, 11)
          t = t + 1
          If t > 100 Then
             MsgBox "Khong duoc in qua 100 dong"
             Sheet7.Range("IN_NX_COGIAN").ClearContents
             Exit Sub
          End If
          Set rng = rng.Offset(1)
          
       Loop
    Application.Calculation = xlCalculationAutomatic
    Range("IN_NX_COGIAN").Rows.AutoFit
    Sheet7.Range("A" & (23 + t)).Resize(125 - 22 - t).EntireRow.Hidden = True
    End If
End If


'lay gia tri cho phieu nhap


If (Sheet7.OptionButton1.Value = True) And (Sheet7.ComboBox1.Value <> "") Then
   For Each rng In Range("NK_NHAP_CHUNGTU")
       If rng.Value = Sheet7.ComboBox1.Value Then
          Sheet7.Range("D15").Value = rng.Offset(0, -1).Value
          Sheet7.Range("Q14").Value = rng.Offset(0, 1).Value
          Sheet7.Range("C17").Value = rng.Offset(0, 2).Value
          Sheet7.Range("H17").Value = rng.Offset(0, 3).Value
          Sheet7.Range("B19").Value = rng.Offset(0, 4).Value
          t = 1
          Exit For
       End If
    Next


    If t > 0 Then
       Do While rng.Value = Sheet7.ComboBox1.Value
          
          Sheet7.Range("A24").Offset(t - 1, 1).Value = rng.Offset(0, 6)
          Sheet7.Range("A24").Offset(t - 1, 5).Value = rng.Offset(0, 5)
          Sheet7.Range("A24").Offset(t - 1, 8).Value = rng.Offset(0, 8)
          Sheet7.Range("A24").Offset(t - 1, 6).Value = rng.Offset(0, 7)
          Sheet7.Range("A24").Offset(t - 1, 9).Value = rng.Offset(0, 9)
          Sheet7.Range("A24").Offset(t - 1, 10).Value = rng.Offset(0, 10)
          Sheet7.Range("A24").Offset(t - 1, 11).Value = rng.Offset(0, 11)
          t = t + 1
          If t > 100 Then
             MsgBox "Khong duoc in qua 100 dong"
             Sheet7.Range("IN_NX_COGIAN").ClearContents
             Exit Sub
          End If
          Set rng = rng.Offset(1)
          
       Loop
    Application.Calculation = xlCalculationAutomatic
    Range("IN_NX_COGIAN").Rows.AutoFit
    Sheet7.Range("A" & (23 + t)).Resize(125 - 22 - t).EntireRow.Hidden = True
    End If
End If


Application.Calculation = tinh


End Sub

321.jpg
 
Web KT
Back
Top Bottom