excel vba Nascondere righe vuote e colonne con dati che pero' non devono essere stampate

Question

Buon Giorno

Ho cannibalizzato diversi codici trovati nella community per evitare che vengano stampate le righe vuote  il risultato ...funziona , pero' non riesco a trovare il metodo per fare lo stesso con  quelle colonne che contengono dati ma non vorrei venissero stampate (es.: col. C e col. H non devono apparire ).

Il codice che uso e' questo , nasconde le righe vuote ,archivia in pdf e alla fine scopre le righe nascoste .

Public Sub cbArchivia_Click()

    Dim cPath As String

    Dim varNomeFile As Variant

    Dim lng As Long

    Dim rng As Range

    Dim c As Range

    Dim bln As Boolean

10

   Application.ScreenUpdating = False

bln = False

With Worksheets("Foglio1")

For lng = 186 To 1 Step -1

bln = False

Set rng = .Range("A" & lng & ":M" & lng)

For Each c In rng

If c.Value <> "" Then

bln = True

End If

Next

If bln = False Then

.Rows(lng).EntireRow.Hidden = True

End If

Set rng = Nothing

Next

End With

Application.ScreenUpdating = True

20

    cPath = BrowseFolder("Seleziona una cartella", _

                         "C:", msoFileDialogViewList)

    If cPath = vbNullString Then

        Call MsgBox(Prompt:="Hai cancellato la selezione della cartella!", _

                    Buttons:=vbOKOnly + vbInformation, _

                    Title:="Uscendo!")

        Exit Sub

    End If

    If Right(cPath, 1) <> Application.PathSeparator Then

        cPath = cPath & Application.PathSeparator

    End If

    varNomeFile = Application.InputBox(Prompt:="Scrivi il nome del file PDF", _

                                       Title:="Nome dal file PDF da salvare", _

                                       Type:=2)

    If varNomeFile = False Then Exit Sub

    If Len(varNomeFile & vbNullString) = 0 Then Exit Sub

    ActiveSheet.ExportAsFixedFormat _

            Type:=xlTypePDF, _

            Filename:=cPath & varNomeFile, _

            Quality:=xlQualityStandard, _

            OpenAfterPublish:=False

30

   Application.ScreenUpdating = False

bln = False

With Worksheets("Foglio1")

For lng = 186 To 1 Step -1

bln = False

Set rng = .Range("A" & lng & ":M" & lng)

For Each c In rng

If c.Value <> "" Then

bln = True

End If

Next

If bln = False Then

.Rows(lng).EntireRow.Hidden = False

End If

Set rng = Nothing

Next

End With

On Error GoTo XIT

    Application.ScreenUpdating = False

XIT:

        Application.ScreenUpdating = True

End Sub

'--------->>

Public Function BrowseFolder(Title As String, _

                             Optional InitialFolder As String = vbNullString, _

                             Optional InitialView As Office.MsoFileDialogView = _

                             msoFileDialogViewList) As String

    Dim V As Variant

    Dim InitFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = Title

        .InitialView = InitialView

        If Len(InitialFolder) > 0 Then

            If Dir(InitialFolder, vbDirectory) <> vbNullString Then

                InitFolder = InitialFolder

                If Right(InitFolder, 1) <> "" Then

                    InitFolder = InitFolder & ""

                End If

                .InitialFileName = InitFolder

            End If

        End If

        .Show

        On Error Resume Next

        Err.Clear

        V = .SelectedItems(1)

        If Err.Number <> 0 Then

            V = vbNullString

        End If

    End With

    BrowseFolder = CStr(V)

End Function

Public Function LastRow(SH As Worksheet, _

                        Optional rng As Range, _

                        Optional minRow As Long = 1)

    If rng Is Nothing Then

        Set rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = rng.Find(What:="*", _

                       after:=rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'--------->>

Public Function LastCol(SH As Worksheet, _

                        Optional rng As Range)

    If rng Is Nothing Then

        Set rng = SH.Cells

    End If

    On Error Resume Next

    LastCol = rng.Find(What:="*", _

                       after:=rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByColumns, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Column

    On Error GoTo 0

End Function

'--------->>

Public Function SheetExists(sSheetName As String, _

                     Optional ByVal WB As Workbook) As Boolean

    On Error Resume Next

    If WB Is Nothing Then

        Set WB = ThisWorkbook

    End If

    SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))

End Function

'--------->>

Public Sub FormatReport(rng As Range)

    With rng

        .Parent.Rows(1).RowHeight = 30

        With .Rows(1)

            .HorizontalAlignment = xlCenter

            .VerticalAlignment = xlCenter

            With .Font

                .Bold = True

            End With

        End With

        End With

End Sub

Grazie  per i suggerimenti     Claudio P

Answer 1

Ho  parzialmente risolto , aggiungendo un pulsante sul foglio interessato , azionandolo , InputBox chiede quali colonne nascondere  ... funziona ... ma solo con  singola colonna o Range di colonne

(Es :   B:B   oppure  A:F  ) se digito nell'ImputBox    B:B,D:D 

Appare   Microsoft Excel     La formula contiene un errore .

Non si vuole digitare una formula ? ..... etc.....

Dove correggere per  poter nascondere  colonne  ANCHE  NON ADIACENTI  ( tipo  B:B,D:D,H:H ) ???

questo il codice

Public Sub Nascondi_Click()

    Dim sColNascondere As String

    Dim Rng As Range   

    Dim iCtr As Long

    Dim sMsg As String, sTitle As String, iButtons As Long   

    Dim CalcMode As Long

    Dim wk1 As Workbook

    Dim sh1 As Worksheet

  Set wk1 = ThisWorkbook

  Set sh1 = wk1.Worksheets("Foglio1")

10

    Set Rng = Application.InputBox( _

              Prompt:="Digita intervallo Colonne da " _

                      & "Nascondere (Es:. A:A,F:F   !", _

              Title:="COLONNE DA NASCONDERE", _

              Type:=8)

    If Rng Is Nothing Then

        Call MsgBox( _

             Prompt:="Non hai Inserito Colonne da Nascondere", _

             Buttons:=vbCritical, _

             Title:="CODICE TERMINATO!")

        Exit Sub

    End If

    sColNascondere = Rng.Address(0, 0)

''    On Error GoTo XIT

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

Application.ScreenUpdating = False

With sh1

   .Range(sColNascondere).EntireColumn.Hidden = True

    End With

    Application.ScreenUpdating = True

On Error GoTo 0

End Sub