Save PDF ด้วย Macro ถ้าจะให้ดูค่าใน CELL ถ้า 0 ไม่ Save ต้องทำอย่างไรครับ

[pangjung39]

คือตอนนี้ผมใช้ Macro Save Sheet "nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5"
แต่ปัญหาคือ บางชีทถ้าค่า AA10 = 0 ไม่ต้องการให้เซฟ ผมต้องเพิ่ม Code อย่างไรครับ

Sub Picture2_Click()
Dim wksAllSheets As Variant
Dim wksSheet1 As Worksheet
Dim strFilename As String, strFilepath As String

'Set references up-front
Set wksSheet1 = ThisWorkbook.Sheets("nm4-1")
wksAllSheets = Array("nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5")
strFilepath = "N:\U-CM\08 GPC InterPipeline and I-4 TruckLoad and Ole&Aro MatTrans\8.04 MAT (GMM)\8.10.01 Billing\Olefins\Excise Olefins\REPORT EXCISE\"

'Create the full Filename using cells D6, E6 and F6
With wksSheet1

'Assemble the string cell-by-cell, "D6 E6-F6"
strFilename = strFilepath & "report" & Format(Range("O4"), "d-mmm-yyyy") & ".pdf"


End With

' 'Save the Array of worksheets (which will be selected) as a PDF
ThisWorkbook.Sheets(wksAllSheets).Select
wksSheet1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

'Make sure all the worksheets are NOT left selected
wksSheet1.Select
End Sub

[logic]

การถามเรื่อง code อ่านกติกาข้อ 4 กับ 5 ด้วย ☝ เดี๋ยวจะไม่มีใครอาสาเข้ามาตอบครับ

[pangjung39]

การถามเรื่อง code อ่านกติกาข้อ 4 กับ 5 ด้วย ☝ เดี๋ยวจะไม่มีใครอาสาเข้ามาตอบครับ

ขอโทษด้วยครับ หาปุ่ม Edit กระทู้ไม่เจอ

[pangjung39]

อันนี้คือชุด Code ทั้งหมดนะครับ อยากจะเพิ่มในส่วนของการตรวจสอบค่า AA10 ทุกชีท ถ้า เท่ากับ 0 ไม่ต้อง Save อะครับ

Code: Select all

Sub Picture2_Click()
Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
    
    'Set references up-front
    Set wksSheet1 = ThisWorkbook.Sheets("nm4-1")
    wksAllSheets = Array("nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5")
    strFilepath = "N:\U-CM\08 GPC InterPipeline and I-4 TruckLoad and Ole&Aro MatTrans\8.04 MAT (GMM)\8.10.01 Billing\Olefins\Excise Olefins\REPORT EXCISE\"
    
    'Create the full Filename using cells D6, E6 and F6
    With wksSheet1

        'Assemble the string cell-by-cell, "D6 E6-F6"
        strFilename = strFilepath & "report" & Format(Range("O4"), "d-mmm-yyyy") & ".pdf"


    End With
    
'    'Save the Array of worksheets (which will be selected) as a PDF
    ThisWorkbook.Sheets(wksAllSheets).Select
    wksSheet1.ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilename, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=True

    'Make sure all the worksheets are NOT left selected
    wksSheet1.Select
End Sub

[logic]

แบบนี้หรือเปล่าครับ

Code: Select all

Sub Picture2_Click()
    Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
    Dim i As Integer
    'Set references up-front
    Set wksSheet1 = ThisWorkbook.Sheets("nm4-1")
    wksAllSheets = Array("nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5")
    strFilepath = "N:\U-CM\08 GPC InterPipeline and I-4 TruckLoad and Ole&Aro MatTrans\8.04 MAT (GMM)\8.10.01 Billing\Olefins\Excise Olefins\REPORT EXCISE\"
    
    For i = 0 To UBound(wksAllSheets)
        If Worksheets(wksAllSheets(i)).Range("AA10").Value = 0 Then
            MsgBox "ตรวจสอบ Sheet " & wksAllSheets(i)
            Exit Sub
        End If
    Next i
    'Create the full Filename using cells D6, E6 and F6
    With wksSheet1

        'Assemble the string cell-by-cell, "D6 E6-F6"
        strFilename = strFilepath & "report" & Format(Range("O4"), "d-mmm-yyyy") & ".pdf"


    End With
    
'    'Save the Array of worksheets (which will be selected) as a PDF
    ThisWorkbook.Sheets(wksAllSheets).Select
    wksSheet1.ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilename, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=True

    'Make sure all the worksheets are NOT left selected
    wksSheet1.Select
End Sub

[pangjung39]

ขอบคุณครับ แต่ยังไม่ใช่อะครับ ผมก็ไม่รู้วิธีเขียนว่าจะทำอย่างไร

-----------
โดยปกติ Code จะทำการSave ชีทที่เลือกทุกตัวเป็น PDF
แต่ผมอยากแปลง ให้ Macro ไปเช็คที่ AA10 ถ้า AA10 เป็น 0 ไม่ต้อง Save ชีทนั้นๆ ครับ แต่ชีทอื่นที่ AA10 มีค่าตั้งแต่ 1 ขึ้นไปก็ Save ปกติครับ

ขอบพระคุณครับ

แบบนี้หรือเปล่าครับ

Code: Select all

Sub Picture2_Click()
    Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
    Dim i As Integer
    'Set references up-front
    Set wksSheet1 = ThisWorkbook.Sheets("nm4-1")
    wksAllSheets = Array("nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5")
    strFilepath = "N:\U-CM\08 GPC InterPipeline and I-4 TruckLoad and Ole&Aro MatTrans\8.04 MAT (GMM)\8.10.01 Billing\Olefins\Excise Olefins\REPORT EXCISE\"
    
    For i = 0 To UBound(wksAllSheets)
        If Worksheets(wksAllSheets(i)).Range("AA10").Value = 0 Then
            MsgBox "ตรวจสอบ Sheet " & wksAllSheets(i)
            Exit Sub
        End If
    Next i
    'Create the full Filename using cells D6, E6 and F6
    With wksSheet1

        'Assemble the string cell-by-cell, "D6 E6-F6"
        strFilename = strFilepath & "report" & Format(Range("O4"), "d-mmm-yyyy") & ".pdf"


    End With
    
'    'Save the Array of worksheets (which will be selected) as a PDF
    ThisWorkbook.Sheets(wksAllSheets).Select
    wksSheet1.ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilename, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=True

    'Make sure all the worksheets are NOT left selected
    wksSheet1.Select
End Sub

[snasui]

Code ที่เขียนมาคือ Export ทุกชีตพร้อมกันทีเดียวไปเป็น 1 ไฟล์

การที่จะไม่ Export ออกไปก็ไต้องไม่เลือกชีตนั้น ๆ ก่อนที่จะ Export ครับ

หากผมเข้าใจถูกต้องตัวอย่างการปรับ Code จะเป็นตามด้านล่างครับ

Code: Select all

'Other code
Dim exptShs() As Variant, i As Integer, j As Integer

'Set references up-front
Set wksSheet1 = ThisWorkbook.Sheets("nm4-1")
wksAllSheets = Array("nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5")
strFilepath = "N:\U-CM\08 GPC InterPipeline and I-4 TruckLoad and Ole&Aro MatTrans\8.04 MAT (GMM)\8.10.01 Billing\Olefins\Excise Olefins\REPORT EXCISE\"

For i = 0 To UBound(wksAllSheets)
    If Worksheets(wksAllSheets(i)).Range("AA10").Value <> 0 Then
        ReDim Preserve exptShs(j)
        exptShs(j) = wksAllSheets(i)
        j = j + 1
    End If
Next i

'Create the full Filename using cells D6, E6 and F6
With wksSheet1

    'Assemble the string cell-by-cell, "D6 E6-F6"
    strFilename = strFilepath & "report" & Format(Range("O4"), "d-mmm-yyyy") & ".pdf"


End With

'    'Save the Array of worksheets (which will be selected) as a PDF
ThisWorkbook.Sheets(exptShs).Select
wksSheet1.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=strFilename, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

'Other code

[pangjung39]

ขอบพระคุณมากๆเลยครับ

[pangjung39]

Code ที่เขียนมาคือ Export ทุกชีตพร้อมกันทีเดียวไปเป็น 1 ไฟล์

การที่จะไม่ Export ออกไปก็ไต้องไม่เลือกชีตนั้น ๆ ก่อนที่จะ Export ครับ

หากผมเข้าใจถูกต้องตัวอย่างการปรับ Code จะเป็นตามด้านล่างครับ

Code: Select all

'Other code
Dim exptShs() As Variant, i As Integer, j As Integer

'Set references up-front
Set wksSheet1 = ThisWorkbook.Sheets("nm4-1")
wksAllSheets = Array("nm4-1", "nm4-2", "nm4-3", "nm4-4", "nm4-5", "nm8-1", "nm8-2", "nm8-3", "nm8-4", "nm8-5")
strFilepath = "N:\U-CM\08 GPC InterPipeline and I-4 TruckLoad and Ole&Aro MatTrans\8.04 MAT (GMM)\8.10.01 Billing\Olefins\Excise Olefins\REPORT EXCISE\"

For i = 0 To UBound(wksAllSheets)
    If Worksheets(wksAllSheets(i)).Range("AA10").Value <> 0 Then
        ReDim Preserve exptShs(j)
        exptShs(j) = wksAllSheets(i)
        j = j + 1
    End If
Next i

'Create the full Filename using cells D6, E6 and F6
With wksSheet1

    'Assemble the string cell-by-cell, "D6 E6-F6"
    strFilename = strFilepath & "report" & Format(Range("O4"), "d-mmm-yyyy") & ".pdf"


End With

'    'Save the Array of worksheets (which will be selected) as a PDF
ThisWorkbook.Sheets(exptShs).Select
wksSheet1.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=strFilename, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

'Other code

ผมขออนุญาติ รบกวนถามเพิ่มเติม พอดีผม ต้องการ เช็คค่าที่ "AA11" ด้วย เหมือนที่เช็คที่ AA10
(ผมลองมาหลายวิธี Search หาคำสั่งจาก GOOGLE)
เงื่อนไขคือ ถ้า AA10 และ AA11 บวกกันไม่เท่ากับ 0 ให้ทำการ Save / ถ้ารวมกันแล้ว เท่ากับ 0 ไม่ต้องSave
ผมตั้ง Range คำสั่งนี้มัน ERROR ครับ
ขอบพระคุณเป็นการล่วงหน้านะครับ

For i = 0 To UBound(wksAllSheets)
If Worksheets(wksAllSheets(i)).Range("AA10:AA11").Value <> 0 Then
ReDim Preserve exptShs(j)
exptShs(j) = wksAllSheets(i)
j = j + 1
End If

[snasui]

เงื่อนไขคือ ถ้า AA10 และ AA11 บวกกันไม่เท่ากับ 0

การคำนวณใน VBA ก็เหมือนกับการคำนวณทั่วไป จากที่ถามมาสามารถเขียนเป็น

If Worksheets(wksAllSheets(i)).Range("AA10").Value + Worksheets(wksAllSheets(i)).Range("AA11").Value <> 0 Then

หรือถ้ามั่นใจว่า A10:A11 คือตัวเลขที่แท้จริง ไม่ใช่เก็บตัวเลขแบบ Text ก็ใช้การรวมเข้ามาช่วยได้ เช่นด้านล่างครับ

If Application.Sum(Worksheets(wksAllSheets(i)).Range("AA10:AA11").Value) <> 0 Then