Snasui Excel Forum

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 wrote: Wed May 27, 2020 10:25 am การถามเรื่อง code อ่านกติกาข้อ 4 กับ 5 ด้วย ☝ เดี๋ยวจะไม่มีใครอาสาเข้ามาตอบครับ

logic wrote: Wed May 27, 2020 4:30 pm แบบนี้หรือเปล่าครับ

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 wrote: Thu May 28, 2020 6:26 pm 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

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

pangjung39 wrote: Mon Jun 01, 2020 4:50 pm เงื่อนไขคือ ถ้า AA10 และ AA11 บวกกันไม่เท่ากับ 0