Forum Pasja Informatyki - Najnowsze pytania i odpowiedzi w Visual Basic

Odpowiedź: dostosowywanie środowiska ścieżki podczas instalacji git

Wed, 10 Apr 2024 15:26:05 +0000

którą opcję wybrać

Jak nie wiesz to rekomendowaną :P Jest na czerwono zaznaczone.

Z drugiej strony podobno narzędzia do uniksa są lepsze od tych w git,

(A tego stwierdzenia nie rozumiem, AFAIK instalacja gita zawiera dosłownie windowsowe porty prostych narzędzi z gnu, więc to... to samo?)

Jak chcesz developować w środowisku unixowym, to używaj VMkę z linuxem (lub bezpośrednio linuxa/maca) zamiast udawać że windows nim jest.

Odpowiedź: Jak efektywnie stosować Web Scraping przy pomocy VBA: Omijanie trudności

Mon, 08 Apr 2024 11:42:59 +0000

Odpowiem z innej bajki, jednak odpowiedź będzie merytorycznie WebScrappingu, więc proszę aby zechciał Pan przeczytać do końca z przymrużonym okiem. Osobiście polecam WebScrapping wykonywać w językach, które posiadają pełne do tego wsparcie ( bezpośrednie - mają gotowe klasy, metody i pośrednie - zbudowane przez społeczność narzędzia, biblioteki, frameworki ). WebScrapping to metoda dostania się do danych, pobrania danych, przedostania się dalej, pobrania kolejnych danych i cały czas, aż do osiągnięcia celu.

VBA nie został stworzony z myślą o WebScrappingu. To jest języka Event-Driven Programming Language. To oznacza, ze jest językiem w większości nasłuchującym do obsługi wydarzeń. Oczywiście można w nim pisać dużo ciekawych rzeczy, tak samo jak da się zrobić grilla w nierdzewnym bębnie od pralki - ale jak sam Pan wie, bęben służy do prania w pralce - dopiero kiedy osiąga status złomu, ludzie wycinają otwór i smażą tam kiełbasy ( serio ).

Połączeniem niezawodnym, które stosuję zawodowo od lat jest zestaw dwóch narzędzi jest:

Python + Selenium + Scrapy
PyTest + Playwright.

WebScrapping - zresztą każdy scrapping, obróbka danych, konwersja - to czysta przyjemność. Próg wejścia nie jest najniższy, ale tez nie jest ultra wysoki.

zmienne C23 w VB flexreport

Sat, 30 Sep 2023 07:58:52 +0000

Hej,

Mam taki temat, chciałbym zacząć używać programu flexreport. Program ten czyta raporty z innego softu, następnie je wypluwa do notatnika w wersji, którą mogę później obrabiać.

Cały problem polega na tym, że w skrypcie poniżej jest zawarta informacja o zmienne C23, pod którą mam zapisywany czas oraz datę. Oprogramowanie flexreport, działa maksymalnie do zmiennej C20. Tu pojawia się całe pytanie, w jaki sposób w poniższym skrypcie mogę zmienić zmienną C23 na np. C6?

Poniżej skrypt:

Option ExplicitDim App As ObjectDim Prg As ObjectDim Cmds As ObjectD - Pastebin.com

A poniżej przedstawiam to co program mi wyrzuca na podstawie tego kodu, tutaj chciałbym C23 zmienić na C5

C1=002439001655
C2=
C3=3
C4=Z:\02 Quality- Jakosc\034 CMM\Programs\Stab Bar 002439001654-1655\002439001655.PRG
C21=2023.02.14
C22=09:10:53
C23=2023.02.14 09:10:53
$END$
$--------------- < > ---------------
          ,FLAT1,0,FLT,0,0.2,0,0.012320981849006,0,0
          ,FLAT2,0,FLT,0,0.2,0,0.027371382239777,0,0
          ,LOC1,0,Z,49.999999999993,0.5,-0.5,50.324993383917,0,0
          ,LOC2,0,X,-57,0.3,-0.3,-57.083164766349,0,0
          ,LOC3,0,X,-74.4,0.5,-0.5,-74.75808622487,0,0
          ,DIST2,0,DISTX,50,0.5,-0.5,49.865254545637,0,0
          ,LOC4,0,R,25,0.5,-0.5,24.892831679233,0,0
          ,DIST7,0,DISTY,62,0.5,-0.5,62.247936452137,0,0
          ,DIST6,0,DISTY,62.6,0.5,-0.5,62.745123770393,0,0
          ,DIST3,0,DISTY,72.6,0.5,-0.5,72.56297611976,0,0
          ,DIST5,0,DISTY,72.6,0.5,-0.5,72.925760999055,0,0
          ,LOC5,0,Y,41.299999999998,0.5,-0.5,41.834720374188,0,0
          ,LOC6,0,Y,-31.300000000002,0.5,-0.5,-31.091040624867,0,0
          ,LOC7,0,Y,-19.300000000002,0.2,-0.2,-19.130126516999,0,0
          ,ANGL7,0,ANG2D,90,1,-1,89.714769504413,0,0
          ,ANGL8,0,ANG2D,89.2,1,-1,89.161111646837,0,0
          ,LOC8,0,X,-17.000000000006,0.3,-0.3,-16.963526148359,0,0
          ,LOC8,0,Z,51.800000000005,0.3,-0.3,51.925159496221,0,0
          ,LOC8,0,D,19,0.3,0,19.228953986031,0,0
          ,LOC9,0,D,12.2,0.25,-0.05,12.32423342264,0,0
          ,LOC10,0,X,-60,0,0,-60.158193932458,1,1
          ,LOC10,0,Z,22.7,0,0,22.800437617394,1,2
          ,LOC10,0,TP,0,0.5,0,0.37476945048577,1,0
          ,ANGL6,0,ANG3D,5.7,0.5,-0.5,6.1814236718784,0,0
          ,DIST1,0,DIST2D,76,1,-1,77.376993848876,0,0
          , 19_DUVAR,0,R,27,0.45,-0.45,27.583810386689,0,0
          ,DUZ_DUVAR,0,R,27,0.45,-0.45,27.030806226465,0,0
          ,DIST4,0,DISTX,51.1,0.2,-0.2,51.06583331568,0,0
$END$

dzięki za pomoc!

Odpowiedź: Dlaczego makro nie działa w komórce

Thu, 21 Sep 2023 13:40:44 +0000

Proponuje drugi parametr dla Weekday zostawić pusty, czyli vba użyje wartości domyślnej dla ustawień systemowych komputera i dla lepszej czytelności kodu proponuje użyć stałych vba vbSaturday i vbSunday

Sub blokujDate()
    Dim cellValue As Date
    Dim dayOfWeek As Integer

    ' Pobierz wartość z komórki C16 jako datę
    cellValue = Range("C16").Value

    ' Sprawdź, który to dzień tygodnia (1 - nie, 2 - pon, ..., 7 - sob)
    dayOfWeek = Weekday(cellValue)

    ' Sprawdź, czy to sobota lub niedziela
    If dayOfWeek = vbSaturday Or dayOfWeek = vbSunday Then
        MsgBox "Wpisałeś dzień niepracujący (" & Format(cellValue, "dddd") & ") !!!"
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$16" Then
        Call blokujDate
    End If
End Sub

Odpowiedź: Wstawienie nowej linii do makro

Wed, 20 Sep 2023 10:03:03 +0000

Spróbuj zapisać to tak, że będziesz po każdym kopiowanym wierszu, opuszczał kolejny wiersz w docelowym arkuszu.

Private Sub Generuj_Click() 
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim h As Integer
 
  table = Range("E5", Range("F5").End(xlDown)).Rows.Count
  Range("E5", Range("F5").End(xlDown)).Select
 
  'Range("E5").Select
  j = 1
  k = 4
 
  ActiveSheet.Shapes.AddShape(msoShapeRectangle, 15, 15, 100, 50).Select
 
  For i = 1 To table
    Worksheets("Spolki").Cells(i + 4, j + 8) = "Inwestycja w spółkę " & Worksheets("Spolki").Cells(RowIndex:=k + 1, ColumnIndex:=5) & _
                                               " w kwocie przypadającej na PFR " & Worksheets("Dashboard").Range("C3") & " FIZ: " & _
                                               Worksheets("Spolki").Cells(RowIndex:=k + 1, ColumnIndex:=6) & " " & Worksheets("Dashboard").Range("C9") ' & vbNewLine
 
    Application.ScreenUpdating = True
    k = k + 2
  Next i 
End Sub

Dynamiczna iteracja po nr rzędu

Tue, 19 Sep 2023 09:27:35 +0000

Cześć, piszę kod, który ma czytać zawartość tabelki (dla przykładu - wypełnionych 5 rzędów) i wkleić treść od komórki H5 w dół, w zależności od ilości wypełnionych wierszy.(zdjęcie dla przykładu)

Mój kod wygląda tak. Na razie generowanie tesktu rozpoczyna się z komórki H5.

Nie do końca wiem jak napisać aby generowanie rozpoczynało się od H5 i szło w dół tyle ile jest wierszy w tabeli. Dodatkowo, są odwołania na sztywno do 5. wiersza, a docelowo miałyby się zmieniać w zależności od rzędu

 Private Sub Generuj_Click()

Dim i As Integer

table = Range("E5", Range("F5").End(xlDown)).Rows.Count
Range("E5", Range("F5").End(xlDown)).Select

'Range("E5").Select

For i = 1 To table
    Range("H5").Select
    'Text = Range("H5", Range("H5").End(xlDown)).Rows.Count
    Range("H5") = "Inwestycja w spółkę " & Worksheets("Spolki").Range("E5") & " w kwocie przypadającej na PFR " & Worksheets("Dashboard").Range("C3") & " FIZ: " & Worksheets("Spolki").Range("F5") & " " & Worksheets("Dashboard").Range("C9")

Next i

Application.ScreenUpdating = True

End Sub

Stworzenie makra w Access, które pobiera plik z Exela i zaczytuje jego dane

Fri, 19 May 2023 13:40:46 +0000

Cześć,

chciałbym nieco zoptymalizować u siebie proces, mianowicie codziennie wpada mi raport na zasób sieciowy w formie zwykłego rozszerzenia exela. Filtruje konkretne kolumny, kopiuje dane ,potem zapisuje w csv i ładuje na maszynę do wykonania.

Chciałbym w Access zrobić makro, które samodzielnie będzie pobierać plik z zasobu, wykonywał zapisane kwarendy i zapisywał formie zwykłego exela , chyba da się zapisać bezpośredniego w csv.

Kwarendy zrobiłem w SQL i wpiąłem do Accessowego makra - wyszukuje się poprawnie, ale rozbija wyszukiwanie na każdą kwarendę osobno , a nie scala w jedno - to pierwszy problem.

Drugi z którym walczę, to napisanie makra aby otwierał i pobierał dane z konkretnej lokalizacji - ale wywala błędy.

Sub OtworzPlikExcel()



    Dim excelApp As Object

    Dim excelWorkbook As Object

    Dim excelWorksheet As Object

    Dim filePath As String

   

    ' Ścieżka do pliku Excel

    filePath = "C:\ścieżka\do\pliku.xlsx"

   

    ' Utwórz nową instancję aplikacji Excel

    Set excelApp = CreateObject("Excel.Application")

   

    ' Wyłącz wyświetlanie okna Excela

    excelApp.Visible = False

   

    ' Otwórz plik Excel

    Set excelWorkbook = excelApp.Workbooks.Open(filePath - ścieżka pliku)

    Set excelWorksheet = excelWorkbook.Sheets("Nazwa_arkusza")

   

    ' Pobierz dane z arkusza Excel do Access

    Dim wartość As Variant

    wartość = excelWorksheet.Range("A1").Value - załóżmy że zakres to od A1 ; A600 do X1 ; X600
chociaż nie wiem czy tutaj nie można użyć in selection? 

 

    ' Zamknij plik Excel

    excelWorkbook.Close

  

    ' Zamknij aplikację Excel

    excelApp.Quit

End Sub

i w sumie już na początku jest błąd - error 429 - activeX component cant create object

pominąłem tworzenie zatem instancji i wtedy pojawia się taki błąd:

error 91 - object variable or With block variable not set - co pewnie wywołuję się przez to że nie ma obiektu.

I nie wiem jak się za to zabrać. Jakieś pomysły?

Odpowiedź: VBA i tabela przestawna

Sat, 01 Oct 2022 20:46:38 +0000

Sprawdź czy Twoja składnia Sheets.Add jest prawidłowa.

Odpowiedź: Excel / Access VBA - nazwa aktualnej sieci

Fri, 02 Sep 2022 00:00:38 +0000

Możesz np. z poziomu VBA (Excel / Access) uruchomić polecenie dos-owe: netsh

netsh wlan show networks mode=bssid

przykład

Option Explicit

Sub wifi() ' przykładowa nazwa makra
    Dim objShell, objShellExec As Variant
    Dim strCmd, strOutput As String
    
    Set objShell = CreateObject("WScript.Shell")
    
    strCmd = "netsh wlan show networks mode=bssid"
    Set objShellExec = objShell.Exec(strCmd)

    strOutput = objShellExec.StdOut.ReadAll
    
    If Not strOutput = vbNullString Then
        Dim intIndex As Integer, arrOutput() As String
        
        MsgBox (strOutput)
        arrOutput = removeEmptyLines(strOutput)
        
        MsgBox arrOutput(2) ' nazwa sieci
        
        'For intIndex = 0 To UBound(arrOutput)
        '    MsgBox arrOutput(intIndex)
        'Next
    End If
End Sub

Function removeEmptyLines(strIn As String) As Variant
    If Len(strIn) > 0 Then
        Dim intIndex As Integer, strTemp, arrTemp() As String
        
        arrTemp = Split(strIn, vbNewLine)
        
        For intIndex = 0 To UBound(arrTemp)
            If Not Trim(arrTemp(intIndex)) = vbNullString Then
                strTemp = strTemp & arrTemp(intIndex) & ";"
            End If
        Next
        
        If Right(strTemp, 1) = ";" Then strTemp = Left(strTemp, Len(strTemp) - 1)
        removeEmptyLines = Split(strTemp, ";")
    Else
        removeEmptyLines = Empty
    End If
End Function

Sprawdź też: VBA - Obtain Wireless Network Name (Connected)

Odpowiedź: Wyciąganie danych z sieci Web

Wed, 20 Jul 2022 21:59:58 +0000

W podanym przez Ciebie linku, kolejne podstrony różnią się ostatnią cyfrą (przecinek i cyfra)

1 strona: https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI
2 strona: https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI,2
3 strona: https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI,3 itd.

dla strony 1 możesz ustawić https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI,1

więc kod, ze strony (chodzi o linię 13)

Czytałem trochę o robieniu pętli makro (tutaj link do wpisu)

Sub ImportStronWeb()
'
' ImportStronWeb Makro
'
 
'
 
Dim intLicznik As Long
intlicznikpodstron = 1 'np 8 podstron
intLicznikWierszy = 1 'np kolejne dane w odstępie 500 wierszy
 
Do While intlicznikpodstron < 8
    With ActiveSheet.QueryTables.Add(Connection:="URL;https://tomaszkenig.pl/page/" & intlicznikpodstron & "/", _
    ' reszta kodu

zamień np. tak

Sub ImportStronWeb()
'
' ImportStronWeb Makro
'
 
'
 
Dim intLicznik As Long
intlicznikpodstron = 1 'np 8 podstron
intLicznikWierszy = 1 'np kolejne dane w odstępie 500 wierszy
 
Do While intlicznikpodstron < 8
    With ActiveSheet.QueryTables.Add(Connection:="URL;https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI," & intlicznikpodstron, _
    ' reszta kodu

oczywiście wartości dla zmiennych: intlicznikpodstron, intLicznikWierszy ustaw według własnych potrzeb.

Visual Basic - zapisywanie ustawień

Tue, 14 Jun 2022 12:00:10 +0000

Cześć. Jestem mega początkujący więc wiadomo...

Pisze programik, który ma dwa przyciski. Jeden z nich otwiera okno explorera i w nim wskazuję lokalizację folderu na dysku. Po wybraniu folderu, program powinien zapisać sobie wskazaną lokalizację po to, aby drugi przycisk otwierał ten folder.

Probel mam z tym że program nie zapisuje mi ustawień i od razu się wywala. Nie działa u mnie taki kod:

My.Settings.ZMIENNA = SelectedPath
My.Settings.Save()

dynamicznej zmiany MySettings użytkownika w aplikacji internetowej

Tue, 10 May 2022 16:56:11 +0000

Chcę w aplikacji internetowej pisanej w vb.net zapisywać ustawienia użytkownika (np. kolor tła) w MySettings. Bez problemu w zakładce Projekt/Właściwości/Ustawienia mogę dodać nazwę zmiennej w polu Nazwa, typ zmiennej w polu Typ i wartość zmiennej w polu Wartość, ale nie mogę zmienić zakresu w polu Zakres z Aplikacja na Użytkownik, co uniemożliwia dynamiczne zmiany ustawień w trakcie działania aplikacji gdyż zmienna jest wówczas tylko do odczytu. Zapewne trzeba coś zmienić w ustawieniach Microsoft Visual Studio 2022. Czy macie jakiś pomysł?

Automatyczne aktualizowanie danych dla innych użytkowników

Wed, 23 Mar 2022 16:11:16 +0000

Witam, stworzyłem makro w Excelu, które nieco automatyzuje prace. Czy ktoś byłby mi w stanie powiedzieć w jaki sposób mógłbym udostępnić ten plik innemu użytkownikowi tak aby każda zmiana w kodzie pojawiała się też u niego?

Odpowiedź: Vb.net dynamiczne wstawianie przycisku i jego oprogramowanie

Fri, 18 Mar 2022 21:06:28 +0000

Dzięki, pomogło. Problem leżał w konieczności ponownego załadowania przycisku w procedurze Page_Load() po wykonaniu postback'u

VBA - wysyłanie maila z załącznikiem przez thunderbirda

Thu, 03 Mar 2022 19:43:59 +0000

Cześć, Mam taki kod który działał u mnie dłuższy czas ale zmieniłem program pocztowy z Outlooka na thunderbirda i nie mogę tego przerobić. A działa on tak że z Excela generuje się pdf który jest zapisywany w danym katalogu a następnie załączany jest do wiadomości jako załącznik. Ktoś ma pomysł jak to zrobić na thunderbirda ?

Sub doPDF()

Dim pdfFileName As String
Dim pdfSaveDir As String
Dim pdfSaveDirYear As String
Dim pdfFile As String
Dim miesiac As String
Dim rok As String

Dim strDir As String
Dim iRet As Integer




ActiveSheet.Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$F$110"
ActiveSheet.PageSetup.Orientation = xlPortrait ' Orientacja strony

If ActiveSheet.Range("b3") <> "" Then
ActiveSheet.Name = Left(ActiveSheet.Range("b3"), 3)
End If

' Pobranie z systemu aktualnego miesiąca i roku
miesiac = Month(Now)
rok = Year(Now)


' Ustalenie ścieżek zapisu pliku
pdfSaveDirYear = "C:\raport\" + rok + "\"
pdfSaveDir = "C:\raport\" + rok + "\" + miesiac + "\"
pdfFileName = "Raport" & Date & "_" & [numer].Value

pdfFile = pdfSaveDir + pdfFileName + ".pdf"
 'MsgBox pdfFile

' Sprawdzenie czy na dysku są katalogi, jeśli nie to tworzymy je
    strDir = pdfSaveDirYear
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        'MsgBox "Directory year exists."
        strDir = ""
    End If
    
    strDir = pdfSaveDir
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        'MsgBox "Directory month exists."
    End If


'Eksport do PDF

With ActiveSheet
    On Error Resume Next
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\" + pdfFile, Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
End With



 'Tworzenie maila z odbiorcami, tytułem oraz załącznikiem
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = "test@test.pl"
        .CC = "test@test.pl; test@test.pl"
        .Subject = pdfFileName
        '.Body = "..."'
        .HTMLBody = "treść wiadomości" & .HTMLBody
        .Attachments.Add pdfFile
        If DisplayEmail = False Then
            '.Send
        End If
 
End With

End Sub

Odpowiedź: Problem z makrem Excel

Thu, 11 Nov 2021 01:03:58 +0000

Proponuję za pomocą jednej pętli bez tworzenia list

Function kiedy_robil_zakupy(kto_dany As String) As String
    Dim r_data As Range
    Dim return_value, skip_value, current_value, last_value, last_row As String
    
    last_row = CStr(Cells(Rows.Count, 3).End(xlUp).Row)
    last_value = vbNullString
    skip_value = vbNullString
 
    For Each r_data In Range("F4:F" & last_row)
        current_value = CStr(Day(r_data.value))
    
        If Cells(r_data.Row, 3).value = kto_dany Then
            skip_value = current_value
        End If
        
        If Not Cells(r_data.Row, 3).value = kto_dany _
           And Not skip_value = current_value _
           And Not last_value = current_value Then
            last_value = current_value
            return_value = return_value & current_value & " "
        End If
        
        If Not InStr(1, return_value, skip_value) = 0 Then
            return_value = Replace(return_value, skip_value, vbNullString)
            return_value = Replace(return_value, "  ", " ")
        End If
    Next
    
    kiedy_robil_zakupy = Replace(Trim(return_value), " ", ", ")
End Function

i bez ustawiania na "sztywno"

Set data = [f4:f22]
Set kto = [c4:c22]
 
For k = "02-1" To "02-27"

Odpowiedź: Kod Excel VBA

Tue, 09 Nov 2021 19:28:26 +0000

Wg mnie wystarczy wpisać gdzieś w makrach Twoją funkcję i potem można ją wywołać w arkuszu - zaznaczasz docelowy obszar, wpisujesz funkcję i wciskasz ctrl+shift+Enter (zamiast zwykłego Enter)

Odpowiedź: Dynamiczne przypisywanie makra do zdarzeń arkusza

Mon, 08 Nov 2021 16:08:53 +0000

Chodzi Tobie pewnie o AddHandler Statement za pomocą, którego przypiszesz dynamicznie zdarzenie Worksheet.Activate event ( o którym wspomniał @overcq) dla nowo utworzonego arkusza

lub

Add VBA code to dynamically created Excel sheets
How to Write a VBA Code to Create a New Sheet in Excel (Macro)

Odpowiedź: VBA - Sumowanie danych w tabeli mających tą samą nazwę

Mon, 08 Nov 2021 01:23:40 +0000

Najpierw oblicz sumę za pomocą funkcji SumIf, czyli

Sub zsumujDane() 
    Dim wynikSumy As Long

    wynikSumy = Application.WorksheetFunction.SumIf(Range("A1:A6"), "KOWALSKI", Range("B1:B6"))
    wynikSumy = Range("E1").Value 
End Sub

teraz przypisz wartość obliczoną, którą "przechowuje" zmienna wynikSumy do komórki E1, czyli

Sub zsumujDane() 
    Dim wynikSumy As Long

    wynikSumy = Application.WorksheetFunction.SumIf(Range("A1:A6"), "KOWALSKI", Range("B1:B6"))
    Range("E1").Value = wynikSumy
End Sub

P.S. "Podkręciłem" trochę Twój kod VBA,

teraz możesz dopisywać więcej linii (wierszy) bez potrzeby zmiany kodu
podwójne kliknięcie lewym przyciskiem myszki w nazwisko wywołuje SumIf z nazwiskiem, które znajduje się w komórce

zapisz ten kod w (edytora VBA - Alt + F11 )


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not IsEmpty(Target.Value) And Target.Column = 1 Then
        zsumujDane (Target.Value)
        Cancel = True
    End If
End Sub

Sub zsumujDane(ByVal name As String)
    Dim wynikSumy As Long
    Dim wynik, ostatni_wiersz As String
 
    ostatni_wiersz = CStr(Cells(Rows.Count, 1).End(xlUp).Row)
 
    wynikSumy = WorksheetFunction.SumIf(Range("A1:A" + ostatni_wiersz), name, Range("B1:B" + ostatni_wiersz))
    wynik = " " + name + ": " + CStr(wynikSumy)
    
    Range("E1").Value = wynik
    Range("E1").ColumnWidth = Len(wynik) + 2
End Sub

Odpowiedź: Excel VBA Thunderbird wypisywanie wartości tablicy w treści maila

Thu, 26 Aug 2021 08:15:59 +0000

Możesz użyć pętli For Each, ma taką zaletę, że "wie" jakiej długości jest tablica.

Propozycja modyfikacji Twojego kodu

Sub Wyslij_maila(dane)
 
Dim thund As String
Dim email As String
Dim temat As String
Dim body  As String
 
email = ";"
temat = "123"
body  = "Dane: "

For Each rekord In dane
   body = body & rekord & " "
Loop

thund = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe " & _
"-compose " & """" & _
"to='" & email & "'," & _
"subject='" & temat & "'," & _
"body='" & body & "'" & """"
 
Call Shell(thund, vbHide)
Application.Wait (Now + TimeValue("0:00:2"))
'SendKeys "^{ENTER}", True
Application.Wait (Now + TimeValue("0:00:2"))
'SendKeys "^{ENTER}", True
 
End Sub

Możesz tez użyć funkcji Join i wtedy masz:

Sub Wyslij_maila(dane)
 
Dim thund As String
Dim email As String
Dim temat As String
Dim body  As String
 
email = ";"
temat = "123"
body  = "Dane: " & Join(dane, " ")

thund = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe " & _
"-compose " & """" & _
"to='" & email & "'," & _
"subject='" & temat & "'," & _
"body='" & body & "'" & """"
 
Call Shell(thund, vbHide)
Application.Wait (Now + TimeValue("0:00:2"))
'SendKeys "^{ENTER}", True
Application.Wait (Now + TimeValue("0:00:2"))
'SendKeys "^{ENTER}", True
 
End Sub

P.S. Zamiast " ", można użyć zapisu Chr(32), zamiast """" - Chr(34) itd.

[ Chr(...) ] [ Character set (0 - 127) ]

Odpowiedź: Microsoft Visual Studio 2019, Visual Basic - ColorDialog

Sat, 31 Jul 2021 13:15:51 +0000

Ja bym zrezygnował z tej pętli, a jak użytkownik nie chce zmienić kolor, zmienił zdanie, gdy już ma otwarty ColorDialog.

Może porostu dodaj do projektu PictureBox i w nim pokazuj wybrany kolor, wtedy nie potrzebujesz zmiennej do przechowywania koloru, bo np.: PictureBox1.BackColor będzie przechowywał wybrany kolor.

Przykład

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Button1.Text = "Wybierz kolor"

        ' Domyslny kolor - uruchomienie programu
        PictureBox1.BackColor = Color.Black
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        ' Ostatio wybrany kolor
        ColorDialog1.Color = PictureBox1.BackColor

        ColorDialog1.ShowDialog()
        PictureBox1.BackColor = ColorDialog1.Color
    End Sub

End Class

Access - filtrowanie danych w podformularzu względem pola kombi

Wed, 16 Jun 2021 08:08:00 +0000

W programie access mam utworzony formularz o nazwie "Wnioski", na którym wyświetlam w formie podformularza inny formularz typu arkusz danych.

Arkusza danych zawiera takie dane jak: Numer wniosku, Data przyjącia, status i Obsługujący. Ponad 1000 pozycji.

Formularz "Wnioski" zawiera również pole kombi, jako listę osób obsługujących. Dane są zaciągane z tej samej tabeli danych co w arkuszu danych dla tej samej kolumny.

Do posortowania danych względem np. Daty przyjęcia zastosowałem makro UstawUporządkujWedług podając nazwę kolumny i nazwę formantu pod formularza.

Jak posortować dane nie używając przycisków nawigacyjnych dla pola Obsługujący, odwołując się do wybranego obsługującego z pola kombi?

Odpowiedź: Excel VBA - Upload, Download FTP

Tue, 11 May 2021 12:49:59 +0000

excel macro download file via FTP

Odpowiedź: Tablica typów w procedurze

Thu, 08 Apr 2021 10:37:12 +0000

Nie mam już dostępu do VB6 (piszę z głowy, czyli z niczego ), ale spróbuj tak

Public Sub Odwiedź (ByRef Budynek As typBudowa, ByVal Index As Integer)
 
     ' ... kod
 
     Dim i As Integer
 
     For i=1 To 10
          ' If i = Index Then
          If Budynek(i) = Budynek(Index) Then
          ' ... kod
          End If
     Next i
 
End Sub
 
' wywołanie procedury:
 
Odwiedź Kościół, 2

BTW, polecam przejść na VB.Net. ( vb6 v. vb.net )

Odpowiedź: Sprawdzenie otwartych (na pasku zadań) plików z excela

Thu, 25 Mar 2021 07:10:45 +0000

Cześć,

Poniżej makro, które wyświetla Ci nazwy otwartych obecnie arkuszów

Sub test()


For Each wb In Workbooks

    MsgBox wb.Name

Next

End Sub

Zamiast wyświetlenia nazwy możesz dodać ją do listy....

Nazwy muszą być unikatowe więc później możesz w podobny sposób wyszukać interesującego Cię skoroszytu (pliku) i z niego wyciągać dane.

Odpowiedź: VBA kopiowanie wartości do kolejnych komórek

Tue, 23 Mar 2021 22:52:00 +0000

Proponuję przypisać makro do przycisku, które będzie pobierać wartość z B:1, i będzie sprawdzać, który wiersz w kolumnie A począwszy od 1, 2, 3, ... itd. jest wolny i wpisywać tam wartość z B:1.

VBA Find Blank Cells and insert text

Select first empty cell in column F starting from row 1. (without using offset)

Odpowiedź: VBA Zliczanie godzin z innych plików do podsumowania

Wed, 17 Feb 2021 18:07:33 +0000

"Wyciąganie" danych z takiego arkusza może okazać nie lada wyczynem.

na początek proponowałbym dodanie kolumny stanowisko jako osobnej np. zaraz po kolumnie imię i nazwisko (ułatwi to parse-owanie danych z kolumny imię i nazwisko).
Na załączonym przez Ciebie obrazku widać, że pracownicy generują różne ilości wierszy i tak:
Monika lp.1 - 3 wiersze
Stanisław lp.2 - 8 wierszy itd.

Jedyne co mi na teraz przychodzi do głowy to przeszukiwanie wierszy po Lp. (kolumna A od 5 wiersza w "dół"),
nowy numer Lp. (większy od poprzedniego w kolumnie A), wpis dotyczący innego pracownika.

Ja to bym zrobił osobny formularz (arkusz) do wprowadzania danych pracownika według tych kryteriów co masz teraz, i na osobnym arkuszu zrobił listę dostępnych pracowników w danym projekcie (numer zlecenia) i po kliknięciu "na pracownika" na liście - dopiero pokazują się dane dla konkretnego pracownika, tylko do wydruku robiłbym zbiorczą tabelę.
Osobny formularz (arkusz) daje nam możliwość zapisania danych do np. pliku csv, xml lub nawet txt, daje nam to łatwiejsze "manipulowanie" danymi.

VBA Read file in Excel (txt, xml, csv, binary)

Przykładowy plik z danymi xml

T-566__25.01.2021.xml

<?xml version="1.0" encoding="UTF-8"?>
<project>
    <project_info>
        <!--b/d - brak danych -->
        <creation_date>25.01.2021</creation_date>
        <name>b/d</name>
        <!--technical_drawing_number - numer rysunku -->
        <technical_drawing_number>b/d</technical_drawing_number>
        <model_number>T-566</model_number>
        <order_number>b/d</order_number>
    </project_info>
    <!-- ewidencja godzin B+R -->
    <records_of_B_R_hours>
        <employee>
            <id>1</id>
            <name>Monika</name>
            <surname>b/d</surname>
            <position>Specjalista R&D</position>
            <operations>
                <operation>
                    <date>11.01.2021</date>
                    <title>Opracowanie dokumentacji technicznej</title>
                    <hours>2</hours>
                </operation>
                <operation>
                    <date>11.01.2021</date>
                    <title>Analiza dokumentacji technicznej</title>
                    <hours>3</hours>
                </operation>
                <operation>
                    <date>28.01.2021</date>
                    <title>Uzgodnienie warunków technicznych</title>
                    <hours>2</hours>
                </operation>                
            </operations>
        </employee>
        <employee>
            <id>2</id>
            <name>Stanisław</name>
            <surname>b/d</surname>
            <position>Technolog</position>
            <operations>
                <operation>
                    <date>19.01.2021</date>
                    <title>Analiza dostarczonej dokumentacji technologicznej</title>
                    <hours>2</hours>
                </operation>
                <operation>
                    <date>19.01.2021</date>
                    <title>Modelowanie 3D</title>
                    <hours>2.5</hours>
                </operation>
                <operation>
                    <date>20.01.2021</date>
                    <title>Przygotowanie</title>
                    <hours>2</hours>
                </operation>
                <operation>
                    <date>20.01.2021</date>
                    <title>Analiza wyników</title>
                    <hours>0.75</hours>
                </operation>
                <operation>
                    <date>21.01.2021</date>
                    <title>Opracowanie dokumentacji 2D</title>
                    <hours>1.5</hours>
                </operation>
                <!-- itd. -->
            </operations>
        </employee>                        
    </records_of_B_R_hours>
</project>

read data from xml file vba excel

Z takiego pliku xml łatwo jest wprowadzić dane do

jak i przeliczyć dane i wprowadzić do

lub

sciezka_pliku = "\\TECHNOLOGIA\EWIDENCJA GODZIN B+R\Projekty_B+R\"
nazwa_pliku = "T-566__25.01.2021.xlsm"

Set project_b_r__app = Workbooks.Open(sciezka_pliku & nazwa_pliku)

Odpowiedź: Dodawanie pól Access przez program napisany w visual basic

Thu, 11 Feb 2021 02:21:56 +0000

Access – VBA – Inserting New Records
Access VBA - Add new row

Odpowiedź: VBA Excel funkcja Select Case

Sun, 07 Feb 2021 00:16:33 +0000

Sub start() 
    Liczba_punktow = Range("A9")
 
    Select Case Liczba_punktow 
        Case 0 To 30
            Range("B1:B9") = "niedostateczny"
        Case 31 To 50
            Range("B1:B9") = "dopuszczający" 
    End Select
End Sub

Set Range in Excel VBA

Problem z zaadresowaniem komórki w VBA (Excel)

Wed, 20 Jan 2021 15:18:30 +0000

Witam,

Próbuję napisać makro, które dodaje wartości wprowadzone w arkuszu1 do planu, który znajduje się w arkuszu2. Użyłem funkcji Adres, Indeks, Podaj pozycję, dzięki czemu mam już adres komórki, do której chcę dodać wartość z Arkusza1.

Nie wiem jak napisać makro, próbowałem na różne sposoby. Największy problem mam, jak edytować komórkę o podanym adresie z arkusza2, tak, aby dodać do niej wartość z komórki z arkusza1.

Będę wdzięczny za pomoc :)

Szymon

Odpowiedź: Makro Word nie zaznacza sformatowanych kolorem wyrażeń

Wed, 23 Dec 2020 21:24:14 +0000

How Can I Search For (and Reformat) Highlighted Text in a Word Document?

Hey, Scripting Guy! How can I find text in a Word document that has been highlighted in a particular color (say, turquoise), and ...

Finding Text Using a Specific Highlighting Color

The only way around this is to use a macro to do the finding. VBA allows you to detect the color used to highlight text, which is why this approach will work. The following macro uses Find and Replace to do the finding, but then it checks to see what the HighlightColorIndex property is for what was found. If it is equal to wdYellow (an enumeration for the color yellow), then the text is selected and the macro is exited.
Sub FindNextYellow()
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindContinue
        .Highlight = True
        Do
            .Execute
        Loop Until Selection.Range.HighlightColorIndex = wdYellow Or Not .Found
        Selection.Range.Select
    End With
End Sub
You can search for different colors simply by changing the wdYellow enumeration to the enumeration for whatever color you want.

Range.HighlightColorIndex property (Word)

Word: Find highlighted text

Makro kopiujące dane - Excel

Thu, 26 Nov 2020 09:34:35 +0000

Witam,

Na wstępie chciałbym powiedzieć, że w VBA jestem jeszcze zielony.

Chciałbym stworzyć makro w Excelu, które po naciśnięciu przycisku czeka aż wybiorę odpowiednią kratkę w kolumnie A. Następnie przechodzi do drugiego arkusza i wkleja w komórkę C4.

Liczę na jakąś podpowiedź. Pozdrawiam

Odpowiedź: Funkcja VBA- dni

Thu, 05 Nov 2020 05:49:22 +0000

Maj ma 31 dni.

Spacje w visual basic

Mon, 26 Oct 2020 22:23:55 +0000

Dzień dobry!!

Potrzebuję pomocy odnośnie zadania, mam za zadanie napisać funkcję, która pokazuje w którym miejscu jest spacja ( chodzi o dokładną liczbę) oraz funkcję, która oddzieli od siebie wyrazy w kolumnie A2 w zależności od tego na jakiej spacji skończyła wcześniejszy wyraz. Tutaj zamieszczam jak to wygląda https://zapodaj.net/f5d6178bebc33.png.html a poniżej jest kod, który już spróbowałem napisać nie wiem czy dobrze.

Function pozycja_spacji(nr As Integer, napis As String) As Long

Dim n, od As Integer
If nr > 4 Or nr <= 0 Then
pozycja_spacji = 0
Else
od = 0
For n = 1 To nr
pozycja_spacji = InStr(od + 1, napis, " ")
Next n
End If
End Function



Function Fragment(nr As Integer, napis As String) As String

Dim x, y As Integer
If nr = 1 Then
x = pozycja_spacji(nr - 1, napis) + 1
y = pozycja_spacji(nr, napis)
ElseIf nr = 2 Then
x = pozycja_spacji(nr - 1, napis)
y = pozycja_spacji(nr, napis) - 2
ElseIf nr >= 4 Then
Fragment = Right(napis, Len(napis) - x)
ElseIf nr = 3 Then
Fragment = Right(Left(napis, y + 1), Len(Left(napis, y + 1)) - x)
Else
Fragment = Mid(napis, x, y)
End If

End Function

Bardzo proszę o pomoc

Odpowiedź: Excel, VBA - Makro uruchamiane przyciskiem spowalnia komputer.

Sat, 26 Sep 2020 02:21:17 +0000

Spróbuj podmienić kod w

Sub UkryjWszystkieArkusze()
   If Not ActiveSheet.Name = "A" Then
      ActiveSheet.Visible = False
   End If 
End Sub

pomijamy iterację po wszystkich arkusza, bo tak zrozumiałem z opisu, że zawsze otwarty jest A i ewentualnie ten na którym praujesz ActiveSheet. Mam nadzieję, że to pomoże (Nie używam Excel'a, piszę z głowy)

Odpowiedź: Czas w Visual Basic

Sat, 05 Sep 2020 15:03:32 +0000

Może to wyglądać mniej więcej tak , z zapisem stanu do pliku xml (który jest tworzony przy pierwszym uruchomieniu):

Imports System.IO
Imports System.Text
Imports System.Xml
Imports WindowsApplication1.ApplicationDataXml

Public Class Form1

    Public Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        SetValueMonthly(TextBox1) ' Wartość domyslnie wzrośnie o 1 np.: TextBox1.Text += 1
        ' TextBox1.Name = Amount
        ' SetValueMonthly(Amount) ' itp.
        ' SetValueMonthly(TextBox1, 3) ' Wartość wzrośnie o 3 np.: TextBox1.text += 3
    End Sub

    Private Sub SetValueMonthly(ByRef TextBox As TextBox, Optional ByVal value As Integer = 1)
        Try
            Dim value_from_xml, value_date_from_xml As String
            value_from_xml = GetValueFromXmlFile("monthly-value", "value")
            value_date_from_xml = GetValueFromXmlFile("monthly-value", "date")

            If String.IsNullOrEmpty(value_from_xml) Or String.IsNullOrEmpty(value_date_from_xml) Then
                Throw New System.Exception("Nie mogę ustawić prawidłowej wartości dla: " & TextBox.Name)
            Else
                Dim textbox_value As Integer = Int32.Parse(value_from_xml)
                Dim check_date As DateTime = Date.Parse(value_date_from_xml)
                Dim check_date_interval As DateTime = check_date.AddMonths(1)
                Dim check_date_today As DateTime = Today.ToString("d")
                Dim date_compare As Integer = DateTime.Compare(check_date_today, check_date_interval)

                If date_compare >= 0 Then ' Minął miesiąc
                    Dim textbox_value_computed As Integer = textbox_value + value
                    ' Zapisanie nowych wartości do pliku xml
                    SetValueToXmlFile("monthly-value", "value", textbox_value_computed)
                    SetValueToXmlFile("monthly-value", "date", check_date_today)
                    TextBox.Text = textbox_value_computed
                Else ' Nie minął miesiąc
                    TextBox.Text = textbox_value
                End If
            End If
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")
        End Try
    End Sub

End Class

Module ApplicationDataXml

    Private Const APP_DATA_FILE_NAME = "data.xml"
    Private APP_PATH As String = Application.StartupPath()
    Private APP_DATA_FILE_PATH As String = Path.Combine(APP_PATH, APP_DATA_FILE_NAME)

    Public Function GetValueFromXmlFile(ByVal node_name As String, ByVal value_name As String) As String
        Try
            Dim return_value As String = String.Empty

            If CreateAppDataXmlFile() Then
                Dim oXMLDoc As New XmlDocument()
                oXMLDoc.Load(APP_DATA_FILE_PATH)
                Dim oNodes As XmlNodeList = oXMLDoc.DocumentElement.SelectNodes(node_name)

                For Each oNode As XmlNode In oNodes
                    return_value = oNode.SelectSingleNode(value_name).InnerText
                Next
            End If

            If String.IsNullOrEmpty(return_value) Then
                Throw New System.Exception("Wartość o nazwie: " & value_name & " nie istnieje.")
            End If

            Return return_value
        Catch ex As Exception
            MsgBox("Nie mogę wczytać wartości: " & node_name & vbCrLf & _
                   "Z pliku: " & APP_DATA_FILE_NAME & vbCrLf & ex.Message,
                   MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")

            Return String.Empty
        End Try
    End Function

    Public Function SetValueToXmlFile(ByVal node_name As String, ByVal value_name As String, ByVal value As String) As Boolean
        Try
            If CreateAppDataXmlFile() Then
                Dim oXMLDoc As New XmlDocument()
                oXMLDoc.Load(APP_DATA_FILE_PATH)
                Dim oNodes As XmlNodeList = oXMLDoc.DocumentElement.SelectNodes(node_name)

                For Each oNode As XmlNode In oNodes
                    oNode.SelectSingleNode(value_name).InnerText = value
                Next

                oXMLDoc.Save(APP_DATA_FILE_PATH)
            End If

            Return True
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")
            Return False
        End Try
    End Function

    Private Function CreateAppDataXmlFile(Optional ByVal overwrite As Boolean = False) As Boolean
        Try
            If Not File.Exists(APP_DATA_FILE_PATH) Or overwrite = True Then
                ' Pierwsze uruchomienie programu tworzenie pliku: APP_DATA_FILE_NAME
                ' Z począkowymi danymi.
                Dim oXMLWriter As New XmlTextWriter(APP_DATA_FILE_PATH, Encoding.UTF8)

                With oXMLWriter
                    .WriteStartDocument(True)
                    .Formatting = Formatting.Indented
                    .Indentation = 2
                    .WriteStartElement("root")

                    .WriteStartElement("monthly-value")

                    .WriteStartElement("value")
                    .WriteString("0") ' Wartość domyślna początkowa
                    .WriteEndElement()

                    .WriteStartElement("date")
                    .WriteString(Today.ToString("d")) ' Data w formie: 05.09.2020
                    .WriteEndElement()

                    .WriteEndElement() ' "/monthly-value"

                    .WriteFullEndElement()
                    .WriteEndDocument()
                    .Close()

                    ' Zostaje zapisany plik xml o takiej strukturze
                    ' <?xml version="1.0" encoding="utf-8" standalone="yes"?>
                    ' <root>
                    '   <monthly-value>
                    '       <value>0</value>
                    '       <date>05.09.2020</date>
                    '   </monthly-value>
                    ' </root>

                End With
            End If

            ' Przy kolejnych uruchomieniach, gdy plik istnieje ...
            Return True ' ... można odczytać dane
        Catch ex As Exception
            MsgBox("Nie mogę utworzyć pliku: " & APP_DATA_FILE_NAME & vbCrLf & _
                   "W lokalizacji: " & APP_PATH, MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")

            Return False
        End Try
    End Function

End Module

data.xml - widok

<?xml version="1.0" encoding="utf-8" standalone="yes"?>
<root>
  <monthly-value>
    <value>0</value>
    <date>05.09.2020</date>
  </monthly-value>
</root>

Odpowiedź: Przekonwertowanie programu w VB6 na plik wykonywalny pod Win7/10

Sat, 01 Aug 2020 21:54:14 +0000

Will a VB6 Application run on Windows 10

How To Install Visual Basic 6 (VB6) in Windows 10

Odpowiedź: Dodawanie pól Access przez program napisany w visual basic

Tue, 28 Jul 2020 22:29:26 +0000

VB.Net - Database Access - Scroll to Example 3 - Creating Table, Columns and Rows
Visual Basic 2017 Lesson 36: Browsing and Editing Data
Adding and Saving Records to Access Database using VB.NET
Insert, Update, Delete & Search Values in MS Access 2003 with VB.NET 2005

INSERT, DELETE, UPDATE AND SELECT Data in MS-Access with VB 2008 Part 1
INSERT, DELETE, UPDATE AND SELECT Data in MS-Access with VB 2008 Part 2

Read data from SQL Query in VB.Net

Simple Visual Basic Database Application using Data Control -Tutorial for beginners
How to Connect Access Database to VB.NET - Visual Studio 2015
VB.NET MS Access Database Tutorial 2 # Add New ,Remove ,Save Data in Database using VB.NET
VB.NET Tutorial - Insert Update Delete Data in Database from DataGridView

Odpowiedź: Logarytmowanie VBA

Thu, 16 Jul 2020 07:54:03 +0000

Nie wiem czy o to chodzi, ale to jest przykładowy kod, który przetwarza komórki w pętli-ciąg Fibbonaciego:

Sub log()
Dim k As Integer

Range("A1").Value = 1
Range("A2").Value = 1

For k = 0 To 20

Range("A3").Offset(k).Value = (Range("A3").Offset(k - 1).Value + Range("A3").Offset(k - 2).Value)

Next

End Sub

Odpowiedź: visual basic excel Liczby pierwsze

Wed, 15 Jul 2020 18:05:57 +0000

Kod nie przeszukuje wszystkich istniejących arkuszy, tylko wybrany przez nas zakres

Sub petla()

Dim rsort As Range
Dim liczba As Integer
Dim i As Integer
Dim sheet As Worksheet

liczba = 0

'Podaj zakres, który się interesuje
On Error Resume Next
Set rsort = Application.InputBox _
("Zaznacz zakres", "Zakres", _
        ActiveCell.Address, , , , , 8)
'dodany warunek żeby  Inputbox się nie sypał, gdy się kliknie Anuluj
If Err.Number <> 0 Then _
Exit Sub
On Error GoTo 0
'dodaj nowy arkusz i nazwij go
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count).Name = "Liczby pierwsze"

'pętla do przetworzenia wszystkich liczb z danego zakresu
For Each cell In rsort
    'dodakowy warunek, bo 2 to też liczba pierwsza
    If cell.Value = 2 Then
        Range("A1").Offset(liczba) = cell.Value
        liczba = liczba + 1
    End If
 'pętla do znalezienia liczb pierwszych
 For i = 2 To cell.Value - 1 Step 1
    If (cell.Value Mod i) = 0 Then
        Exit For
    ElseIf i = cell.Value - 1 Then
        Range("A1").Offset(liczba) = cell.Value
        liczba = liczba + 1
        Exit For
    End If
 Next
Next cell

'sortowanie liczb pierwszych
Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Liczby pierwsze").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Liczby pierwsze").Sort.SortFields.Add2 Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Liczby pierwsze").Sort
        .SetRange Range("A1:A24")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Odpowiedź: Visual Basic skróty klawiszowe w tle

Mon, 06 Jul 2020 01:57:59 +0000

Virtual-Key Codes.

Imports System.Runtime.InteropServices

Public Class Form1

    Dim testCount As Integer = 0

    Public Const MOD_ALT As Integer = &H1 'Alt key
    Public Const WM_HOTKEY As Integer = &H312

    <DllImport("User32.dll")> _
    Public Shared Function RegisterHotKey(ByVal hwnd As IntPtr, _
                        ByVal id As Integer, ByVal fsModifiers As Integer, _
                        ByVal vk As Integer) As Integer
    End Function

    <DllImport("User32.dll")> _
    Public Shared Function UnregisterHotKey(ByVal hwnd As IntPtr, _
                        ByVal id As Integer) As Integer
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, _
                        ByVal e As System.EventArgs) Handles MyBase.Load
        RegisterHotKey(Me.Handle, 100, MOD_ALT, Keys.F9)
        RegisterHotKey(Me.Handle, 200, MOD_ALT, Keys.F10)
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As System.Object, _
                        ByVal e As System.Windows.Forms.FormClosingEventArgs) _
                        Handles MyBase.FormClosing
        UnregisterHotKey(Me.Handle, 100)
        UnregisterHotKey(Me.Handle, 200)
    End Sub

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        If m.Msg = WM_HOTKEY Then
            Dim id As IntPtr = m.WParam
            Select Case (id.ToString)
                Case "100"
                    Timer1.Start()
                    Debug.Print("Timer1.Start")
                Case "200"
                    Timer1.Stop()
                    Debug.Print("Timer1.Stop")
            End Select
        End If
        MyBase.WndProc(m)
    End Sub


    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        testCount += 1
        Debug.Print(testCount)
    End Sub
End Class

Odpowiedź: Automatyczne otwieranie okna i podwójne kliknięcia VISUAL BASIC

Sat, 04 Jul 2020 22:40:06 +0000

Public Class Form1
    Private oForm As Form

    ' Przycisk na Form1
    Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
        Try
            oForm.Visible = True
        Catch ex As Exception            
            initializeForm()
        Finally
            oForm.Visible = True
        End Try
    End Sub

    Private Sub initializeForm()
        oForm = New Form
        ' Przykładowe ustawienia okna
        oForm.Text = "Form2" ' Dowlny tekst - caption okna
        oForm.Size = New Size(200, 200)
        oForm.MaximumSize = New Size(200, 200)
        oForm.MinimumSize = New Size(200, 200)
        oForm.Owner = Me
        oForm.FormBorderStyle = FormBorderStyle.FixedDialog
        oForm.ControlBox = False
        oForm.AutoSize = False
        AddHandler oForm.Activated, AddressOf Form2_Activated

        ' Dodawanie checkbox'ów
        Dim locationOffset As Integer = 20
        Dim width As Integer = 20
        Dim checkboxName As String() = New String() {"Pytanie1", "Pytanie2", "Pytanie3", "Pytanie4", "Pytanie5"}
        Dim checkboxText(5) As String

        checkboxText(0) = "Tresć pytanie 1"
        checkboxText(1) = "Tresć pytanie 2"
        checkboxText(2) = "Tresć pytanie 3"
        checkboxText(3) = "Tresć pytanie 4"
        checkboxText(4) = "Tresć pytanie 5"

        For index As Integer = 0 To checkboxName.GetUpperBound(0)
            Dim checkBox = New CheckBox
            checkBox.Location = New Point(20, locationOffset)
            checkBox.Size = New Size(100, width)
            checkBox.Name = checkboxName(index)
            checkBox.Text = checkboxText(index)
            oForm.Controls.Add(checkBox)
            locationOffset = locationOffset + width
        Next

        Dim button = New Button
        button.Location = New Point(20, locationOffset)
        button.Size = New Size(100, 20)
        button.Text = "Wprowadź"
        AddHandler button.Click, AddressOf Form2_Button1_Click

        oForm.Controls.Add(button)
    End Sub

    ' Przycisk na utworzonej Form'ie
    Private Sub Form2_Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

        ' Kod do sprawdzenia stanu checkBox'ów z utworzonej Form'atki

        Dim msgboxStyle As MsgBoxStyle = msgboxStyle.Information + msgboxStyle.OkOnly + msgboxStyle.SystemModal
        For Each control In oForm.Controls
            If (TypeOf (control) Is CheckBox) Then
                MsgBox(control.Name & " = " & control.checked, msgboxStyle)

                If (control.Name = "Pytanie1" And control.checked = True) Then
                    MsgBox("Pytanie1 - zaznaczony" & vbCrLf & control.Text, msgboxStyle)
                End If
            End If
        Next

        ' Koniec sprawdzenia stanu 

        oForm.Visible = False
    End Sub

    ' Nowa Form'atka zawsze pokazuje się nad Form1
    Private Sub Form2_Activated()
        oForm.Location = Me.Location
    End Sub
End Class

Odpowiedź: Pytanie odnośnie tworzenia okienek i ich zawartości.

Wed, 01 Jul 2020 17:09:33 +0000

Chodzi Ci o to?

msgBox(tekst)

Oczywiście standardowo tekst w cudzysłowie chyba, że chcesz wyświetlić zmienną

Odpowiedź: Czy da się napisać aplikację w visual basic i używać ją na androidzie?

Wed, 01 Jul 2020 08:38:45 +0000

https://www.techwalla.com/articles/can-i-make-android-apps-with-visual-basic

Odpowiedź: Vb.net WebBrowser problem z HTML5 i Adobe flash player

Mon, 22 Jun 2020 06:28:13 +0000

Internet Explorer w wersji 11 nie wspiera HTML5 oraz wtyczki Flash. Zmień element WebBrowser na coś obsługującego silnik Chromium. W przypadku Adobe Flash Player sprawdź czy przeglądarka ma włączoną opcję Flash.

Odpowiedź: Skrypt z WSH połączony z informacjami systemowymi (a także ich zapisywaniem do pliku)

Sat, 30 May 2020 04:13:25 +0000


Dim WshShell
Dim WshProcEnv
Dim objFSO, objFile
Dim file_name
Dim process_architecture
Dim process_identifier
Dim process_revision
Dim raport

Const OVER_WRITE = True


Set WshShell =  CreateObject("Wscript.Shell")
Set WshProcEnv = WshShell.Environment("Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")

process_architecture= WshProcEnv("PROCESSOR_ARCHITECTURE")
process_identifier = WshProcEnv("PROCESSOR_IDENTIFIER")
process_revision = WshProcEnv("PROCESSOR_REVISION")

raport = "Type of CPU on the computer: "  & process_architecture & vbCrLf & _
         "Type of ID: "  & process_identifier & vbCrLf & _
         "Version of the CPU: "  & process_revision

MsgBox  raport, vbOKOnly + vbInformation , "Information about the processor"

file_name = objFSO.BuildPath(WshShell.CurrentDirectory,"dane.txt")
Set objFile = objFSO.CreateTextFile(file_name, OVER_WRITE)
    objFile.WriteLine(raport)
    objFile.Close

Odpowiedź: Vba procenty

Thu, 14 May 2020 12:37:53 +0000

Tutaj w punkcie 2 masz to jasno wyjaśnione.

https://tomaszkenig.pl/kurs-excel-vba/instrukcja-warunkowa-if-then-else-w-excel-vba/

Powiadomienia na innym komputerze Visual Basic

Wed, 06 May 2020 16:27:49 +0000

Witam,

Nie wiem jak zrobić program w Visual Basic, aby po kliknięciu przycisku wysyłał powiadomienie na inny komputer.

Z góry dziękuję za odpowiedź

vba- kopiowanie tekstu z worda do worda

Fri, 01 May 2020 19:20:57 +0000

Witam,
Mam 2 pliki worda. Jeden plik to plik z danymi a drugi to szablon. W pierwszym pliku zaznaczam tekst (który jest sformatowany) i chciałabym, żeby ten tekst skopiowało z oryginalnym formatowaniem do pliku szablon. Mam taki kod:

    'eksport do Worda
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = False

    Set wordDoc = wordApp.Documents.Open("C:\wyciagi\szablon\szablon_wyciag.docm")

    Set wordSelection = wordApp.Selection
        
        '-- wstawianie tresci -----------------------------
        Selection.Copy
        zaznaczenie = Selection.Text
        'Selection.Find.ClearFormatting
        'Selection.Find.Replacement.ClearFormatting
        
        With wordSelection.Find
            .Text = "$tresc_punktu"
            .Forward = True
            .Replacement.Text = zaznaczenie
            .Wrap = wdFindContinue
        End With
        
        Do While Selection.Find.Execute
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
       Loop
    
    '----- zapisanie do pliku ------------------------------
    wordDoc.SaveAs "C:\wyciagi\wyciag.doc", FileFormat:=wdFormatXMLDocument
    
    wordDoc.Close (False)
    Set wordDoc = Nothing

    wordApp.Quit
    Set wordApp = Nothing

Niestety powyższy kod nie wkleja zaznaczonego tekstu do pliku szablon.

Jeśli tekst: $tresc_punktu znajduje się w pliku pierwszym to zostanie zamieniony na zaznaczony tekst.

VBA - Excel - otwieranie folderów o przypisanej nazwie

Tue, 07 Apr 2020 12:22:19 +0000

Witam, chciałbym uzyskać informacje, czy w VBA dla Excela mogę zrobić taką funkcję, która po kliknięciu odpowiedniego przycisku będzie wyszukiwała odpowiedni indeks, następnie po znalezieniu go, otworzy folder na dysku. Obecnie mam takie wyszukiwanie po indeksie gdy kliknę na dane pole w arkuszu, wyszukuje mi nr_indeksu, następnie z innego arkusza wyświetla mi informacje i dane przypisane do niego. Chciałbym teraz utworzyć przycisk, który będzie otwierał odpowiedni folder z dysku o nazwie kodu zabranego z pola dane. Zależy mi, aby wyszukać za pomocą nr_indeksu dane opisane jakimś numerem, następnie aby otworzyć folder z danym numerem "dane". Nie wiem czy jest możliwość aby do ścieżki podczas kompilacji wpisywał się znaleziony numer danych który jest wyszukiwany podczas wywołania numeru indeksu. Bardzo proszę o ewentualne nakierowanie w dobrym kierunku. Z góry dziękuję ! :)

Kod wyszukiwania informacji i wyświetlania ich po kliknięciu na pole w Arkuszu:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

nr_indeksu= ActiveCell.Value
wskaznik_wiersza = 1

    Do

    wskaznik_wiersza = wskaznik_wiersza + 1

    If Sheets("Arkusz").Cells(wskaznik_wiersza, 3) = "" Then Exit Do

    Loop While Sheets("Arkusz").Cells(wskaznik_wiersza, 3) <> nr_indeksu

dane= Sheets("Arkusz").Cells(wskaznik_wiersza, 4)

UserForm2.TextBox30.Value = nr_indeksu
UserForm2.TextBox29.Value = dane

UserForm2.Show
Cancel = True

End Sub