|  Porada 6 marca 2020Wykorzystanie pliku XML do przechowywania danych konfiguracyjnych. 
Poniższy program prezentuje wykorzystanie biblioteki XML Dom do odczytywania danych zawartych w pliku XML.
 Sub GetConfiguration(strFile As String, ByRef Data() As String, ByRef Number As Long)
 Dim oXML As MSXML2.DOMDocument
 Dim oList As MSXML2.IXMLDOMNode
 Dim i As Long
 
 Set oXML = New MSXML2.DOMDocument
 oXML.async = True
 oXML.Load strFile
 
 For Each oList In oXML.getElementsByTagName("List")
 Data(i, 1) = oList.Attributes.getNamedItem("Name").nodeTypedValue
 Data(i, 2) = oList.SelectSingleNode("Size").nodeTypedValue
 Data(i, 3) = oList.SelectSingleNode("Price").nodeTypedValue
 i = i + 1
 Next oList
 
 Numer = oXML.SelectSingleNode("//Config/Number").nodeTypedValue
 
 Set oXML = Nothing
 
 End Sub
 
 '-------------------------------------------------------------------
 Sub Test()
 
 Dim Data(0 To 1, 1 To 3) As String
 Dim Number As Long
 
 GetConfiguration "config.xml", Data, Number
 
 MsgBox "Name: " & vbTab & Data(0, 1) & vbCrLf & _
 "Size: " & vbTab & Data(0, 2) & vbCrLf & _
 "Price: " & vbTab & Data(0, 3) & vbCrLf & _
 "Number: " & vbTab & Numer
 
 End Sub
 
poniżej listing pliku config.xml:
 <?xml version="1.0" encoding="utf-8"?><Config>
 
 <List Name="Pierwszy">
 <Size>S</Size>
 <Price>100</Price>
 </List>
 
 <List Name="Drugi">
 <Size>XXL</Size>
 <Price>105</Price>
 </List>
 
 <Number>2</Number>
 
 </Config>
zamieścił: admin
 
 
 
  Porada 3 marca 2020Usuwanie krótkich segmentów w krzywych w CorelDraw. Sub RemoveSmallSegments()
 Dim sShape As Shape
 If ActiveShape Is Nothing Then Exit Sub Else Set sShape = ActiveShape
 
 Dim oShapeRange As ShapeRange
 Dim dDist As Double
 Dim X As Double, Y As Double, W As Double, H As Double, i As Long
 Dim lDirection As cdrContourDirection
 
 sShape.GetBoundingBox X, Y, W, H
 
 'set offset as 0.02 (2%) of heigth of the selected shape
 dDist = H * 0.02
 
 For i = 1 To 4
 If i = 1 Or i = 4 Then lDirection = cdrContourOutside Else lDirection = cdrContourInside
 sShape.CreateContour lDirection, dDist, 1, cdrDirectFountainFillBlend, , , , 0, 0, cdrContourSquareCap, cdrContourCornerMiteredOffsetBevel, 0
 sShape.ConvertToCurves
 Set oShapeRange = sShape.Effects(1).Separate
 Set sShape = oShapeRange(1)
 oShapeRange(2).Delete
 Next i
 
 sShape.Selected = True
 Set oShapeRange = Nothing
 
 End Sub
zamieścił: admin
 
 
 
  19 kwietnia 2019 
 
 Nowy skrypt VBS w dziale Skrypty VBS , służący do instalacji dodatków Worda.zamieścił: admin
 
 
 
  9 kwietnia 2019 
 
 Nowy link , pod ktorym mozna znalezc kontrolke kalendarza, dzialajaca w 64-bitowym Office.zamieścił: admin
 
 
 
  5 kwietnia 2019 
 
 Nowe makro w dziale Excel . 
Makro służy do zamiany liczb na postać słowną.zamieścił: admin
 
 
 
  16 marca 2019 
 
 Nowe makro w dziale Excel .zamieścił: admin
 
 
 
  Porada 25 marca 2018W czasie pracy nad makrem do CorelDraw szukałem sposobu, by odczytać z poziomu VBA informacje o rozdzielczości i wymiarach pliku *.png. 
Oto przykładowe rozwiązanie:
 Sub ImageInfos()
 Dim objImage
 
 Set objImage = CreateObject("WIA.ImageFile")
 objImage.LoadFile ścieżka_do_pliku
 
 MsgBox "Szerokość: " & objImage.Width & vbCrLf & _
 "Wysokość: " & objImage.Height & vbCrLf & _
 "Rozdz. pozioma: " & objImage.Horizontalresolution & vbCrLf & _
 "Rozdz. pionowa: " & objImage.Verticalresolution
 
 Set objImage = Nothing
 
 End Sub
zamieścił: admin
 
 
 
  29 listopada 2017 
 
 Nowe makro w dziale Excel, demonstrujące w jaki sposób zapisywać na stale dane wpisywane do kontrolki Combobox. zamieścił: admin
 
 
 
  Porada 16 września 2017Jak stworzyć w Excelu listę plików z wybranego folderu. Option Explicit
 Function GetFolder(sTitle As String, Optional sButtonName As String = vbNullString, Optional strPath As String = vbNullString) As String
 
 Dim fldr As FileDialog
 Dim sItem As String
 
 Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
 
 With fldr
 .Title = sTitle
 .AllowMultiSelect = False
 .ButtonName = sButtonName
 .InitialFileName = strPath
 If .Show = -1 Then GetFolder = .SelectedItems(1) Else GetFolder = vbNullString
 End With
 
 Set fldr = Nothing
 
 End Function
 
 Sub GetFilelist()
 
 Dim sPath As String
 sPath = GetFolder("Wybierz folder z plikami", "Wybierz")
 If sPath = vbNullString Then Exit Sub
 
 Dim oFS, oFolder, oFile
 Dim i As Long: i = 2
 
 Set oFS = CreateObject("Scripting.FileSystemObject")
 Set oFolder = oFS.GetFolder(sPath)
 
 If oFolder.Files.Count = 0 Then
 MsgBox "W wybranym katalogu nie ma plików.", vbInformation
 Set oFolder = Nothing
 Set oFS = Nothing
 Exit Sub
 End If
 
 Dim lWKCount As Long
 Dim oWBK As Workbook
 
 lWKCount = Application.SheetsInNewWorkbook
 
 Application.SheetsInNewWorkbook = 1
 Set oWBK = Application.Workbooks.Add
 
 Application.SheetsInNewWorkbook = lWKCount
 
 oWBK.Worksheets(1).Range("A1").Value = "nazwa pliku"
 oWBK.Worksheets(1).Range("B1").Value = "rozmiar"
 oWBK.Worksheets(1).Range("C1").Value = "data utworzenia"
 oWBK.Worksheets(1).Range("A1").Font.Italic = True
 oWBK.Worksheets(1).Range("B1").Font.Italic = True
 oWBK.Worksheets(1).Range("C1").Font.Italic = True
 
 For Each oFile In oFolder.Files
 
 oWBK.Worksheets(1).Range("A" & i).Value = oFile.Name
 
 Select Case oFile.Size
 Case 0 To 1023
 oWBK.Worksheets(1).Range("B" & i).Value = Format(oFile.Size, "0") & " B"
 Case 1024 To 1048575
 oWBK.Worksheets(1).Range("B" & i).Value = Format(oFile.Size / 1024, "0") & " KB"
 Case 1048576 To 1073741823
 oWBK.Worksheets(1).Range("B" & i).Value = Format(oFile.Size / 1048576, "0") & " MB"
 Case 1073741824 To 1.11111111111074E+20
 oWBK.Worksheets(1).Range("B" & i).Value = Format(oFile.Size / 1073741823, "0.00") & " GB"
 End Select
 
 oWBK.Worksheets(1).Range("B" & i).HorizontalAlignment = xlRight
 
 oWBK.Worksheets(1).Range("C" & i).Value = oFile.DateCreated
 
 i = i + 1
 
 Next oFile
 
 oWBK.Worksheets(1).Columns("A:C").AutoFit
 
 Set oWBK = Nothing
 Set oFolder = Nothing
 Set oFS = Nothing
 
 End Sub
zamieścił: admin
 
 
 
  16 września 2017 
 
 zamieścił: admin
 
 
 
 
 
  wszystkich stron: 13 
 |