PDA

View Full Version : help



محتاج2010
06-05-2011, 01:12 PM
Is it possible to use some of the macro for another Macro ?

Chabu
06-05-2011, 01:52 PM
Could you please state your question clearly?

محتاج2010
06-05-2011, 02:53 PM
sorry

Maybe I can not explain what I want because my English is not good; but

How do I create a table according to from a specific range to the end of Existing data?

محتاج2010
06-05-2011, 03:25 PM
my file

CatDaddy
06-06-2011, 10:46 AM
no file attached! :No

Aussiebear
06-07-2011, 02:16 AM
What is the location of the start of the range to be compiled into a table?

محتاج2010
06-07-2011, 07:45 AM
You are very kind, thank you so much for your; for assistance .. And have found a solution to the problems in your forum wonderful .. And I have another problem,:



how can changw this range by (i) ???

i = 1000

'' مهم جدا حساب الشحن و العمولات بشكل صحيح
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))" ' how can changw this range by (i) ???
Range("R12").FormulaR1C1 = "=IF(AND(RC15>=0,RC16>0),R5C9/SUM(R12C17:R1000C17))"
'' مهم جدا حساب الشحن و العمولات بشكل صحيح

محتاج2010
06-07-2011, 08:00 AM
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))"

how can i change this range R1000C23 by (i)

Because (i) variable .

in the code:

On Error Resume Next
Dim Last As Long
Dim Count As Integer
Count = 1
Count = D
With ActiveSheet
Last = .Range("G" & .ROWS.Count).End(xlUp).Row
.ROWS(Last).Copy .ROWS(Last + 0).Resize(Count)
.ROWS(Last + 0).Resize(Count).SpecialCells(xlConstants).ClearContents
End With
On Error GoTo 0


Creates new rows each containing such this

Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))"
:R1000C23))

1000 is not required and a description, but sometimes much less

محتاج2010
06-07-2011, 08:02 AM
i can't add file here but I'll put here the code

'Option Explicit
Sub GetDataDemo()
' استدعاءبيانات بيان التعبئة من غير حاجة إلى فتحه
If [a12] > 0 Then MsgBox "There is data in the (INVOICE) OR (INVOICE) is not ready!!": Exit Sub ' عند وجود بيانات في الفاتورة يمنع عمل الكود
'*************************************** 'فك الحماية
Call unpass
'***************************************
Dim FilePath$, D
'***************************************
Const FileName$ = "PACKING LIST.XLS"
Const SheetName$ = "paCking list"
FilePath = ActiveWorkbook.Path & "\"
'***************************************
DoEvents

Application.ScreenUpdating = False
'**********Call mak_pak*****************************

'=========================================
'**********لعرض قيمة الفاتورة في التيكست بوكس*****************************
Address = [R5].Address
TOT = Getbaba(FilePath, FileName, SheetName, Address)
'**********لعرض قيمة الفاتورة في التيكست بوكس*****************************
Address = [a5].Address
D = Getbaba(FilePath, FileName, SheetName, Address)
'b = MsgBox("القيمة" & " " & ":" & TOT & vbNewLine & vbNewLine & FileName & " : الملف " & vbNewLine & "The number of styles is : " & D, vbOKCancel + vbQuestion + vbMsgBoxRight, "Confirmation request Packing")
b = MsgBox("سيكون قيمة الفاتورة بالعملة الصينية هو : " & " " & ":" & TOT & vbNewLine & vbNewLine & FileName & " : الملف " & vbNewLine & "عدد أصناف هذه الفاتورة سيكون : " & D, vbOKCancel + vbQuestion + vbMsgBoxRight, "Confirmation request Packing")
If b = vbOK Then
If D = vbOKCancel Then Exit Sub
GoTo 11

'Prompt = " Import items" & vbNewLine & vbNewLine & Path & vbCrLf & " The number of styles is : "
'D = InputBox(Prompt, vbCrLf, Title & D)
'If D = Cancel Then Call pass: Exit Sub


'*************************************** نسخ صفوف المعادلات حسب عدد الأصناف
11

''' مهم جدا حساب الشحن و العمولات بشكل صحيح
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))"
Range("R12") = "=IF(AND(RC15>=0,RC16>0),R5C9/SUM(R12C17:R1000C17))"
'' مهم جدا حساب الشحن و العمولات بشكل صحيح
On Error Resume Next
Dim Last As Long
Dim Count As Integer
Count = 1
Count = D
With ActiveSheet
Last = .Range("G" & .ROWS.Count).End(xlUp).Row
.ROWS(Last).Copy .ROWS(Last + 0).Resize(Count)
.ROWS(Last + 0).Resize(Count).SpecialCells(xlConstants).ClearContents
End With
On Error GoTo 0
Address = Range("A5").Address
D = Getbaba(FilePath, FileName, SheetName, Address)
'=========================================
'*************************************** تسلسل

For Row = 1 To D
For Column = 1 To 1
Address = Cells(Row, Column).Address
lRow = Range("a" & ROWS.Count).End(xlUp).Row
Range("a" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** تسلسل

'*************************************** رقم موديل
Address = Range("A5").Address
D = Getbaba(FilePath, FileName, SheetName, Address)
For Row = 1 To D
For Column = 3 To 3
Address = Cells(Row, Column).Address
lRow = Range("b" & ROWS.Count).End(xlUp).Row
Range("b" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** رقم موديل
'*************************************** الوصف
For Row = 1 To D
For Column = 2 To 2
Address = Cells(Row, Column).Address
lRow = Range("c" & ROWS.Count).End(xlUp).Row
Range("c" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** الوصف
'*************************************** الكمية
For Row = 1 To D
For Column = 17 To 17
Address = Cells(Row, Column).Address
lRow = Range("d" & ROWS.Count).End(xlUp).Row
Range("d" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** الكمية
'*************************************** السعر
For Row = 1 To D
For Column = 16 To 16
Address = Cells(Row, Column).Address
lRow = Range("e" & ROWS.Count).End(xlUp).Row
Range("e" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
'Columns.AutoFit
Next
Next
'*************************************** السعر
'*************************************** التاريخ
Address = [G5].Address
[c9] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** التاريخ
'*************************************** رقم الفاتورة
Address = [C5].Address
[e9] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** رقم الفاتورة

'*************************************** أجور الشحن
Address = [C4].Address
[I5] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** أجور الشحن
'*************************************** حجم الحاوية
Address = [a4].Address
[g9] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** حجم الحاوية
COLUMNS.AutoFit
'*************************************** نسخ صفوف المعادلات حسب عدد الأصناف
[a10] = "=MAX(R[2]C:R[990]C)" 'إعادة عد الأصناف في الفاتورة
Range("j10") = "=SUM(R12C50:R1000C50)" ' جمع المصاريف على الفاتورة
ActiveWorkbook.Worksheets("مبيعات").Names("الفاتورة_دولار").RefersToR1C1 = "=مبيعات!R12C9:R1000C9"
ActiveWorkbook.Worksheets("مبيعات").Names("عمولة_ادخارية").RefersToR1C1 = "=مبيعات!R12C47:R1000C47"
ActiveWorkbook.Worksheets("مبيعات").Names("عمولة_مصاريف").RefersToR1C1 = "=مبيعات!R12C48:R1000C48"
ActiveWorkbook.Worksheets("مبيعات").Names("الفاتورة_يوان_بدون_مصاريف").RefersToR1C1 = "=مبيعات!R12C40:R1000C40"
ActiveWorkbook.Worksheets("مبيعات").Names("عمولة_وسيط").RefersToR1C1 = "=مبيعات!R12C46:R1000C46"
ActiveWorkbook.Worksheets("مبيعات").Names("قيمة_الفاتورة").RefersToR1C1 = "=مبيعات!R12C9:R1000C9"
COLUMNS.AutoFit
COLUMNS("F:F").Select
Selection.EntireColumn.Hidden = True
Range(Selection, Selection.End(xlToRight)).Select
COLUMNS("N:IT").Select
Selection.EntireColumn.Hidden = True
'*************************************** ' إعادة ترقيم أسماء النطاقات بعد حذف أصناف الفاتورة
Call pass
If Sheet <> ("main") = False Then
End If
Call acc
Call mak_packing
Call mak_packing_GUANG
Call add_main:
Call short_tot
Call mk_in_jed

End If
'Call BK_IN_GU
'Call BK_JE
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Address).Range("A8").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function
Private Function Getbaba(Path, File, Sheet, Address)
' تمت إضافته اضطرارا
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
Getbaba = ExecuteExcel4Macro(Data)
End Function